home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue35 / pageprnt / PAGEPRNT.ZIP / PagePrnt / PagePrnt.pas < prev    next >
Pascal/Delphi Source File  |  1997-10-26  |  91KB  |  2,722 lines
  1. {Uncomment this $DEFINE to produce the shareware version.}
  2. {You must also uncomment the line in PgPrnAbt.}
  3. //{$DEFINE PAGEPRINT_SHAREWARE}
  4. (*******************************************************************************
  5.  
  6. TPagePrinter Version 2.0
  7. 8/8/96 - 10/26/97
  8. Copyright ⌐ 1996-1997 Bill Menees
  9. bmenees@usit.net
  10. http://www.public.usit.net/bmenees
  11.  
  12. This is a VCL component that encapsulates the Printer object and does
  13. Print Preview.  I make no claim to it's correct functioning, so use
  14. it at your own risk.
  15.  
  16. It **REQUIRES** long strings, enhanced metafiles, the Win32 common
  17. controls, and it makes use of several Win32 specific API calls.
  18. This means it can't be used with Delphi 1.0, so please don't ask, beg,
  19. threaten, etc.  It has been tested with and seems to work fine with
  20. Delphi 2.0, Delphi 3.0, and C++Builder 1.0.
  21.  
  22. Before you e-mail me with a question, MAKE SURE YOU CHECK THE SOURCE CODE FIRST!
  23. I don't mind helping people with problems if they have honestly tried to
  24. solve the problem first.  However, I won't even reply to questions whose
  25. answers are obvious when you look at the source (e.g. Can I use this with
  26. Delphi 1.0?).
  27.  
  28. Historical Note: This component has its origins in TLinePrinter.
  29. I started off calling this component TLinePrinter Version 2.0, but
  30. I decided a new class name was more appropriate for several reasons.  The
  31. main reason was that TLinePrinter is a non-visual component, and the new
  32. component is a visual component.  I didn't want the new visual component to
  33. start showing up on forms where the V.1.0 component hadn't shown!  A new
  34. class name also gave me the chance to redefine the interface entirely.
  35. I added, edited, renamed, and deleted many properties, methods, events,
  36. and units.  I think you'll agree the changes are for the better.
  37.  
  38. *******************************************************************************)
  39.  
  40. {$LONGSTRINGS ON}
  41. unit PagePrnt;
  42.  
  43. interface
  44.  
  45. uses
  46.   Windows, Messages, SysUtils, Classes, Graphics, Controls,
  47.   Forms, Dialogs, Printers, ExtCtrls,
  48. {$IFDEF PAGEPRINT_SHAREWARE}
  49.   PgPrnPrg, PgPrnAbt;
  50. {$ELSE}
  51.   PgPrnPrg;
  52. {$ENDIF}
  53.  
  54. const
  55.   {In Pixels}
  56.   DefaultBorderWidth = 2;
  57.   DefaultDPI = 300;
  58.   {In Inches}
  59.   DefaultAvailablePageHeightIn = 10.5;
  60.   DefaultAvailablePageWidthIn = 8.0;
  61.   DefaultGutterLeftIn = 0.25;
  62.   DefaultGutterTopIn = 0.25;
  63.   DefaultPhysicalPageHeightIn = 11.0;
  64.   DefaultPhysicalPageWidthIn = 8.5;
  65.   {In Millimeters}
  66.   DefaultAvailablePageHeightMm = 284.0;
  67.   DefaultAvailablePageWidthMm = 198.0;
  68.   DefaultGutterLeftMm = 6.0;
  69.   DefaultGutterTopMm = 6.0;
  70.   DefaultPhysicalPageHeightMm = 297.0;
  71.   DefaultPhysicalPageWidthMm = 210.0;
  72.   {These are expanded only in Headers, Footers, and Tables.}
  73.   DateField = '{$DATE}';
  74.   LineField = '{$LINE}';
  75.   PageField = '{$PAGE}';
  76.   TimeField = '{$TIME}';
  77.   TitleField = '{$TITLE}';
  78.   {Progress Dialog Messages}
  79.   ProgressFinishMsg = '<FINISH>';
  80.   SendingPagesMsg = 'Sending Pages To Printer';
  81.  
  82. type
  83.   EPagePrinter = class(EPrinter);
  84.   TGradientOrientation = (goHorizontal, goVertical);
  85.   TLineSpacing = (lsHalfSpace, lsSingleSpace, lsSingleAndAHalf, lsDoubleSpace);
  86.   TMeasurement = Double;
  87.   TMeasureUnit = (muInches, muMillimeters);
  88.   TPageBorder = (pbTop, pbBottom, pbLeft, pbRight);
  89.   TPageBorders = set of TPageBorder;
  90.   TPixels = Cardinal;
  91.   TPrintCanvas = TMetafileCanvas;
  92.   TPrintPage = TMetafile;
  93.   TZoomLocation = (zlTopLeft, zlTopCenter, zlCenter);
  94.  
  95.   TPageList = class(TList)
  96.   public
  97.         destructor Destroy; override;
  98.         function GetPage(const Index: Integer): TPrintPage;
  99.   end;
  100.  
  101.   TPagePrinter = class(TScrollBox)
  102.   private
  103.     { Private declarations }
  104.     fAbortOnCancel: Boolean;
  105.     fAlignment: TAlignment;
  106.     fAutoFooterFont: Boolean;
  107.     fAutoHeaderFont: Boolean;
  108.     fCancelPrinting: Boolean;
  109.     fCanvas: TPrintCanvas;
  110.     fCollate: Boolean;
  111.     fCopies: Cardinal;
  112.     {These X,Y are relative to the printable space.
  113.      They should normally be bounded by the Margins.
  114.      So 0,0 is the left,top corner of the printable space.
  115.      fCurrentY is negative only when printing the header.}
  116.     fCurrentX, fCurrentY: Integer;
  117.     fDefaultColWidth: TMeasurement;
  118.     fFileName: String;
  119.     fFileVar: TextFile;
  120.     fFooterFont: TFont;
  121.     fFriendlyFooter: String;
  122.     fFriendlyHeader: String;
  123.     fGradientBackground: Boolean;
  124.     fHeader, fFooter: String;
  125.     fHeaderFont: TFont;
  126.     fHeaderFormat, fFooterFormat: String;
  127.     fLineNumber: Cardinal;
  128.     fLines: TStrings;
  129.     fLineSpace: TPixels;
  130.     fLineSpacing: TLineSpacing;
  131.     fMarginBottom: TMeasurement;
  132.     fMarginLeft: TMeasurement;
  133.     fMarginRight: TMeasurement;
  134.     fMarginTop: TMeasurement;
  135.     fMeasureUnit: TMeasureUnit;
  136.     fOnNewLine: TNotifyEvent;
  137.     fOnNewPage: TNotifyEvent;
  138.     fPage: TPrintPage;
  139.     fPageBorderOffset: TMeasurement;
  140.     fPageBorders: TPageBorders;
  141.     fPageNumber: Cardinal;
  142.     fPages: TPageList;
  143.     fPaintBox: TPaintBox;
  144.     fPPPrnPrgDlg: TPPPrnPrgDlg;
  145.     fPrinter: TPrinter;
  146.     fPrintFromPage: Cardinal;
  147.     fPrinting: Boolean;
  148.     fPrintingHeaderOrFooter: Boolean;
  149.     fPrintingToFile: Boolean;
  150.     fPrintToFile: Boolean;
  151.     fPrintToPage: Cardinal;
  152.     fProgressMessage: String;
  153.     fShadowColor: TColor;
  154.     fShadowOffset: TPixels;
  155.     fShowCancel: Boolean;
  156.     fShowMargins: Boolean;
  157.     fShowProgress: Boolean;
  158.     fStillCreating: Boolean;
  159.     fTableFormat: String;
  160.     fTableGrid: Boolean;
  161.     fTabSize: Cardinal;
  162.     fTextMetrics: TTextMetric;
  163.     fTokenSeparator: Char;
  164.     fUpdateRefCount: Cardinal;
  165.     fUsingTempPage: Boolean;
  166.     fWordWrap: Boolean;
  167.     fZoomLocation: TZoomLocation;
  168.     fZoomPercent: Cardinal;
  169.  
  170.     function GetAutoFooterFont: Boolean;
  171.     function GetAutoHeaderFont: Boolean;
  172.     function GetAvailablePageHeight: TMeasurement;
  173.     function GetAvailablePageWidth: TMeasurement;
  174.     function GetCanvas: TPrintCanvas;
  175.     function GetCanvasPosition: TPoint;
  176.     function GetCollate: Boolean;
  177.     function GetCopies: Cardinal;
  178.     function GetDefaultColWidth: TMeasurement;
  179.     function GetFileName: String;
  180.     function GetFooterFont: TFont;
  181.     function GetFooterFormat: String;
  182.     function GetFriendlyFooter: String;
  183.     function GetFriendlyHeader: String;
  184.     function GetGradientBackground: Boolean;
  185.     function GetGutterBottom: TMeasurement;
  186.     function GetGutterLeft: TMeasurement;
  187.     function GetGutterRight: TMeasurement;
  188.     function GetGutterTop: TMeasurement;
  189.     function GetHeaderFont: TFont;
  190.     function GetHeaderFormat: String;
  191.     function GetLineNumber: Cardinal;
  192.     function GetLines: TStrings;
  193.     function GetLineSpacing: TLineSpacing;
  194.     function GetMarginBottom: TMeasurement;
  195.     function GetMarginLeft: TMeasurement;
  196.     function GetMarginRight: TMeasurement;
  197.     function GetMarginTop: TMeasurement;
  198.     function GetMeasureUnit: TMeasureUnit;
  199.     function GetOrientation: TPrinterOrientation;
  200.     function GetPageBorderOffset: TMeasurement;
  201.     function GetPageBorders: TPageBorders;
  202.     function GetPageCount: Cardinal;
  203.     function GetPageNumber: Cardinal;
  204.     function GetPages(Indx: Cardinal): TPrintPage;
  205.     function GetPhysicalPageHeight: TMeasurement;
  206.     function GetPhysicalPageWidth: TMeasurement;
  207.     function GetPreviewPagePixelsH: TPixels;
  208.     function GetPreviewPagePixelsV: TPixels;
  209.     function GetPrintableHeight: TMeasurement;
  210.     function GetPrintableWidth: TMeasurement;
  211.     function GetPrintFromPage: Cardinal;
  212.     function GetPrinting: Boolean;
  213.     function GetPrintToFile: Boolean;
  214.     function GetPrintToPage: Cardinal;
  215.     function GetProgressMessage: String;
  216.     function GetShadowColor: TColor;
  217.     function GetShadowOffset: TPixels;
  218.     function GetShowCancel: Boolean;
  219.     function GetShowMargins: Boolean;
  220.     function GetShowProgress: Boolean;
  221.     function GetTableFormat: String;
  222.     function GetTitle: String;
  223.     function GetZoomPercent: Cardinal;
  224.     function PixelPrintHeight: TPixels;
  225.     function PixelPrintWidth: TPixels;
  226.     function StartingBottom: TPixels;
  227.     function StartingLeft: TPixels;
  228.     function StartingRight: TPixels;
  229.     function StartingTop: TPixels;
  230.     function StoreFooterAndFormat: Boolean;
  231.     function StoreFooterFont: Boolean;
  232.     function StoreHeaderAndFormat: Boolean;
  233.     function StoreHeaderFont: Boolean;
  234.  
  235.     procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
  236.     procedure CreateTempPage;
  237.     procedure DoNewPageProcessing;
  238.     procedure FinishPrintPage;
  239.     procedure NewPrintPage;
  240.     procedure OnCancelPrinting(Sender: TObject);
  241.     procedure ResetPageList(CreateForReal: Boolean);
  242.     procedure SetAutoFooterFont(Value: Boolean);
  243.     procedure SetAutoHeaderFont(Value: Boolean);
  244.     procedure SetCollate(Value: Boolean);
  245.     procedure SetCopies(Value: Cardinal);
  246.     procedure SetDefaultColWidth(Value: TMeasurement);
  247.     procedure SetFileName(Value: String);
  248.     procedure SetFooterFont(Value: TFont);
  249.     procedure SetFooterFormat(Value: String);
  250.     procedure SetFriendlyFooter(Value: String);
  251.     procedure SetFriendlyHeader(Value: String);
  252.     procedure SetGradientBackground(Value: Boolean);
  253.     procedure SetHeaderFont(Value: TFont);
  254.     procedure SetHeaderFormat(Value: String);
  255.     procedure SetLines(Value: TStrings);
  256.     procedure SetLineSpacing(Value: TLineSpacing);
  257.     procedure SetMarginBottom(Value: TMeasurement);
  258.     procedure SetMarginLeft(Value: TMeasurement);
  259.     procedure SetMarginRight(Value: TMeasurement);
  260.     procedure SetMarginTop(Value: TMeasurement);
  261.     procedure SetMeasureUnit(Value: TMeasureUnit);
  262.     procedure SetOrientation(Value: TPrinterOrientation);
  263.     procedure SetPageBorderOffset(Value: TMeasurement);
  264.     procedure SetPageBorders(Value: TPageBorders);
  265.     procedure SetPageNumber(Value: Cardinal);
  266.     procedure SetPrintFromPage(Value: Cardinal);
  267.     procedure SetPrintToFile(Value: Boolean);
  268.     procedure SetPrintToPage(Value: Cardinal);
  269.     procedure SetProgressMessage(Value: String);
  270.     procedure SetShadowColor(Value: TColor);
  271.     procedure SetShadowOffset(Value: TPixels);
  272.     procedure SetShowCancel(Value: Boolean);
  273.     procedure SetShowMargins(Value: Boolean);
  274.     procedure SetShowProgress(Value: Boolean);
  275.     procedure SetTableFormat(Value: String);
  276.     procedure SetTitle(Value: String);
  277.     procedure SetZoomPercent(Value: Cardinal);
  278.  
  279.   protected
  280.     { Protected declarations }
  281.     function ExpandLogicalFields(S: String): String;
  282.     function GetClippedLine(const Line: String; const Width: TPixels): String;
  283.     function GetPreviewPagePixels(Horz: Boolean): TPixels;
  284.     function GetPrinterHandle: HDC;
  285.     function GetScaleFactor(Horz: Boolean): Double;
  286.     function MeasureUnitsToScreenPixels(const Value: TMeasurement; Horz: Boolean): TPixels;
  287.     function ScaleValue(Value: TMeasurement; Horz: Boolean): TPixels;
  288.     function ValidateFormatString(const Fmt: String; const ConvertUnits: Boolean): String;
  289.     procedure ExpandFriendlyFormat(const UserFmt: String; AsHeader: Boolean);
  290.     procedure Invalidate; override;
  291.     procedure Loaded; override;
  292.     procedure PaintPreview(Sender: TObject); virtual; //OnPaint handler for TPaintBox
  293.     procedure ParseFormatToken(var CurToken: String; var CurAlignment: TAlignment; var CurWidth: TMeasurement);
  294.     procedure SetPixelsPerInch;
  295.     procedure SplitLine(var CurLine: String; var Buffer: String; const ClipWidth: TPixels; const TrimLastWhiteSpace: Boolean);
  296.     procedure SplitLineAndPrint(const Line: String; UseWrite: Boolean);
  297.     procedure UpdateDesigner;
  298.     procedure UpdatePagePreviewSize;
  299.     procedure UpdateProgressDlg(const Status: String; const CurrentPage, FromPage, ToPage: Cardinal);
  300.     procedure WriteTableGrid(const CurWidth: TPixels; const TopGrid, BottomGrid: Boolean);
  301.  
  302.   public
  303.     { Public declarations }
  304.     {Largest printable space on the page.}
  305.     property AvailablePageHeight: TMeasurement read GetAvailablePageHeight;
  306.     property AvailablePageWidth: TMeasurement read GetAvailablePageWidth;
  307.     property Canvas: TPrintCanvas read GetCanvas;
  308.     property CanvasPosition: TPoint read GetCanvasPosition;
  309.     property GutterBottom: TMeasurement read GetGutterBottom;
  310.     property GutterLeft: TMeasurement read GetGutterLeft;
  311.     property GutterRight: TMeasurement read GetGutterRight;
  312.     property GutterTop: TMeasurement read GetGutterTop;
  313.     property LineNumber: Cardinal read GetLineNumber;
  314.     property PageCount: Cardinal read GetPageCount;
  315.     property PageNumber: Cardinal read GetPageNumber write SetPageNumber;
  316.     property Pages[Indx: Cardinal]: TPrintPage read GetPages;
  317.     property PhysicalPageHeight: TMeasurement read GetPhysicalPageHeight;
  318.     property PhysicalPageWidth: TMeasurement read GetPhysicalPageWidth;
  319.     {Printable space bounded by the margins.}
  320.     property PrintableHeight: TMeasurement read GetPrintableHeight;
  321.     property PrintableWidth: TMeasurement read GetPrintableWidth;
  322.     property PrintFromPage: Cardinal read GetPrintFromPage write SetPrintFromPage default 0;
  323.     property Printing: Boolean read GetPrinting;
  324.     property PrintToPage: Cardinal read GetPrintToPage write SetPrintToPage default 0;
  325.  
  326.     constructor Create(Owner: TComponent); override;
  327.     destructor Destroy; override;
  328.     function MeasureUnitsToPixelsH(const M: TMeasurement): TPixels;
  329.     function MeasureUnitsToPixelsV(const M: TMeasurement): TPixels;
  330.     function NewLine: Cardinal;
  331.     function NewPage: Cardinal;
  332.     function PixelsToMeasureUnitsH(const P: TPixels): TMeasurement;
  333.     function PixelsToMeasureUnitsV(const P: TPixels): TMeasurement;
  334.     function PrevLine: Boolean;
  335.     function Print: Boolean;
  336.     procedure BeginDoc;
  337.     procedure BeginUpdate;
  338.     procedure Clear;
  339.     procedure EndDoc;
  340.     procedure EndUpdate;
  341.     procedure RefreshProperties;
  342.     procedure Write(const Line: String);
  343.     procedure WriteLine(const Line: String);
  344.     procedure WriteLineAligned(const AAlignment: TAlignment; const Line: String);
  345.     procedure WriteLines(const LinesAsTable: Boolean);
  346.     procedure WriteTableLine(const Line: String);
  347.     procedure ZoomToFit;
  348.     procedure ZoomToHeight;
  349.     procedure ZoomToWidth;
  350.  
  351.   published
  352.     { Published declarations }
  353.     {Because everything in TPagePrinter depends on it, this property MUST be the first
  354.     TPagePrinter-specific property loaded.  If you edit the form as text and move it
  355.     around in the streaming order, things may not work correctly.  This dependency kind
  356.     of stinks, but I can't think of any way around it.  Sorry.}
  357.     property MeasureUnit: TMeasureUnit read GetMeasureUnit write SetMeasureUnit default muInches;
  358.  
  359.     property AbortOnCancel: Boolean read fAbortOnCancel write fAbortOnCancel default False;
  360.     property Align;
  361.     property Alignment: TAlignment read fAlignment write fAlignment default taLeftJustify;
  362.     property AutoFooterFont: Boolean read GetAutoFooterFont write SetAutoFooterFont default True;
  363.     property AutoHeaderFont: Boolean read GetAutoHeaderFont write SetAutoHeaderFont default True;
  364.     property Collate: Boolean read GetCollate write SetCollate default True;
  365.     property Color;
  366.     property Copies: Cardinal read GetCopies write SetCopies default 1;
  367.     property DefaultColWidth: TMeasurement read GetDefaultColWidth write SetDefaultColWidth stored True;
  368.     property DragCursor;
  369.     property DragMode;
  370.     property Enabled;
  371.     property FileName: String read GetFileName write SetFileName;
  372.     property Footer: String read fFooter write fFooter stored StoreFooterAndFormat;
  373.     property FooterFont: TFont read GetFooterFont write SetFooterFont stored StoreFooterFont;
  374.     property FooterFormat: String read GetFooterFormat write SetFooterFormat stored StoreFooterAndFormat;
  375.     property FriendlyFooter: String read GetFriendlyFooter write SetFriendlyFooter;
  376.     property FriendlyHeader: String read GetFriendlyHeader write SetFriendlyHeader;
  377.     property GradientBackground: Boolean read GetGradientBackground write SetGradientBackground default True;
  378.     property Header: String read fHeader write fHeader stored StoreHeaderAndFormat;
  379.     property HeaderFont: TFont read GetHeaderFont write SetHeaderFont stored StoreHeaderFont;
  380.     property HeaderFormat: String read GetHeaderFormat write SetHeaderFormat stored StoreHeaderAndFormat;
  381.     property Lines: TStrings read GetLines write SetLines;
  382.     property LineSpacing: TLineSpacing read GetLineSpacing write SetLineSpacing default lsSingleSpace;
  383.     property MarginBottom: TMeasurement read GetMarginBottom write SetMarginBottom;
  384.     property MarginLeft: TMeasurement read GetMarginLeft write SetMarginLeft;
  385.     property MarginRight: TMeasurement read GetMarginRight write SetMarginRight;
  386.     property MarginTop: TMeasurement read GetMarginTop write SetMarginTop;
  387.     property OnNewLine: TNotifyEvent read fOnNewLine write fOnNewLine;
  388.     property OnNewPage: TNotifyEvent read fOnNewPage write fOnNewPage;
  389.     property OnStartDrag;
  390.     property Orientation: TPrinterOrientation read GetOrientation write SetOrientation default poPortrait;
  391.     property PageBorderOffset: TMeasurement read GetPageBorderOffset write SetPageBorderOffset;
  392.     property PageBorders: TPageBorders read GetPageBorders write SetPageBorders default [];
  393.     property ParentColor;
  394.     property ParentFont default False;
  395.     property PrintToFile: Boolean read GetPrintToFile write SetPrintToFile default False;
  396.     property ProgressMessage: String read GetProgressMessage write SetProgressMessage;
  397.     property ShadowColor: TColor read GetShadowColor write SetShadowColor default clBtnShadow;
  398.     property ShadowOffset: TPixels read GetShadowOffset write SetShadowOffset default 5;
  399.     property ShowHint;
  400.     property ShowCancel: Boolean read GetShowCancel write SetShowCancel default True;
  401.     property ShowMargins: Boolean read GetShowMargins write SetShowMargins default True;
  402.     property ShowProgress: Boolean read GetShowProgress write SetShowProgress default True;
  403.     property TableFormat: String read GetTableFormat write SetTableFormat;
  404.     property TableGrid: Boolean read fTableGrid write fTableGrid default False;
  405.     property TabSize: Cardinal read fTabSize write fTabSize default 8;
  406.     property Title: String read GetTitle write SetTitle nodefault;
  407.     property TokenSeparator: Char read fTokenSeparator write fTokenSeparator default '|';
  408.     property Visible;
  409.     property WordWrap: Boolean read fWordWrap write fWordWrap default True;
  410.     property ZoomLocation: TZoomLocation read fZoomLocation write fZoomLocation default zlTopLeft;
  411.     property ZoomPercent: Cardinal read GetZoomPercent write SetZoomPercent default 25;
  412.   end;
  413.  
  414. function ExpandTabsAsSpaces(const S: String; const TabSize: Cardinal): String;
  415. function GenSpace(const Size: Cardinal): String;
  416. function ReplaceSubString(const OldSubStr, NewSubStr: String; S: String): String;
  417. function StripBackToWhiteSpace(const S: String): String;
  418. procedure FillGradient(Canvas: TCanvas; Rc: TRect; LeftTopColor, RightBottomColor: TColor; Orientation: TGradientOrientation);
  419. procedure TokenizeString(const S: String; TokenSeparator: Char; Tokens: TStringList);
  420.  
  421. implementation
  422.  
  423. {Typically gutters are symmetrical on printers, but GetDeviceCaps
  424. doesn't report back bottom or right gutters.  If I calculate these
  425. gutters based on other information returned by GetDeviceCaps (instead
  426. of just assuming things are symmetrical), I get a smaller and
  427. typically incorrect result.  I think symmetric gutters are what we
  428. want in most cases, but you can comment this $DEFINE out if you want
  429. the gutters to be calculated based on the exact values returned by
  430. GetDeviceCaps.}
  431. {$DEFINE USE_SYMMETRIC_GUTTERS}
  432.  
  433. {$R PagePrnt.dcr}
  434.  
  435. {=============================================================================}
  436. { Non-methods that may prove useful elsewhere.                                }
  437. {=============================================================================}
  438.  
  439. function ReplaceSubString(const OldSubStr, NewSubStr: String; S: String): String;
  440. var
  441.    P: Cardinal;
  442. begin
  443.      {Currently, this routine is terribly inefficient since Pos
  444.      always starts back at the beginning of the string.  However,
  445.      our header, footer, and table strings are usually very short,
  446.      so this doesn't matter much in practice.}
  447.      Result := '';
  448.      P := Pos(OldSubStr, S);
  449.      while (P <> 0) do
  450.      begin
  451.           Result := Result + Copy(S, 1, P-1) + NewSubStr;
  452.           Delete(S, 1, P-1+Length(OldSubStr));
  453.           P := Pos(OldSubStr, S);
  454.      end;
  455.      Result := Result+S;
  456. end;
  457.  
  458. procedure TokenizeString(const S: String; TokenSeparator: Char;
  459.           Tokens: TStringList);
  460. var
  461.    i, Len: Cardinal;
  462.    CurToken: String;
  463. begin
  464.      Tokens.Clear;
  465.      CurToken:='';
  466.      Len:=Length(S);
  467.      for i:=1 to Len do
  468.      begin
  469.           if S[i] = TokenSeparator then
  470.           begin
  471.                Tokens.Add(CurToken);
  472.                CurToken:='';
  473.           end
  474.           else
  475.               CurToken:=CurToken+S[i];
  476.      end;
  477.      Tokens.Add(CurToken);
  478. end;
  479.  
  480. function StripBackToWhiteSpace(const S: String): String;
  481. var
  482.    i, Len, Mark: Cardinal;
  483. begin
  484.      Mark:=0;
  485.      Len:=Length(S);
  486.      for i:=Len downto 1 do
  487.      begin
  488.           if S[i] in [#0..#32] then
  489.           begin
  490.                Mark:=i;
  491.                Break;
  492.           end;
  493.      end;
  494.  
  495.      if Mark > 0 then Result:=Copy(S, 1, Mark)
  496.      {If there is nowhere to break, just return the whole line.}
  497.      else Result:=S;
  498. end;
  499.  
  500. function ExpandTabsAsSpaces(const S: String; const TabSize: Cardinal): String;
  501. var
  502.    i, Len, Size: Cardinal;
  503.    Buffer: String;
  504. begin
  505.      {TabStr:='';
  506.      for i:=1 to TabSize do TabStr:=TabStr+' ';}
  507.  
  508.      Buffer:='';
  509.      Len:=Length(S);
  510.      for i:=1 to Len do
  511.      begin
  512.           if S[i]=#9 then
  513.           begin
  514.                Size:=TabSize-(Length(Buffer) mod TabSize);
  515.                Buffer:=Buffer+GenSpace(Size);
  516.           end
  517.           else Buffer:=Buffer+S[i];
  518.      end;
  519.      Result:=Buffer;
  520. end;
  521.  
  522. function GenSpace(const Size: Cardinal): String;
  523. var
  524.    Str: String;
  525. begin
  526.      Str:='';
  527.      while Length(Str) < Size do Str:=Str+' ';
  528.      GenSpace:=Str;
  529. end;
  530.  
  531. procedure FillGradient(Canvas: TCanvas; Rc: TRect;
  532.           LeftTopColor, RightBottomColor: TColor; Orientation: TGradientOrientation);
  533. var
  534.    LR, LG, LB, RR, RG, RB, MR, MG, MB: Integer; //Left, Right, and Mix RGBs
  535.    i, LeftRGB, RightRGB, LeftWeight, RightWeight, Times: Longint;
  536.    MixColor: TColor;
  537. begin
  538.      LeftRGB:=ColorToRGB(LeftTopColor);
  539.      LR:=GetRValue(LeftRGB);
  540.      LG:=GetGValue(LeftRGB);
  541.      LB:=GetBValue(LeftRGB);
  542.      RightRGB:=ColorToRGB(RightBottomColor);
  543.      RR:=GetRValue(RightRGB);
  544.      RG:=GetGValue(RightRGB);
  545.      RB:=GetBValue(RightRGB);
  546.      if Orientation = goHorizontal then
  547.         Times:=Rc.Right-Rc.Left-1
  548.      else
  549.          Times:=Rc.Bottom-Rc.Top-1;
  550.      if Times > 0 then
  551.      begin
  552.           for i:=0 to Times do
  553.           begin
  554.                LeftWeight:=Times-i;
  555.                RightWeight:=i;
  556.                MR:=(LR*LeftWeight+RR*RightWeight) div Times;
  557.                MG:=(LG*LeftWeight+RG*RightWeight) div Times;
  558.                MB:=(LB*LeftWeight+RB*RightWeight) div Times;
  559.                MixColor:=RGB(MR, MG, MB);
  560.                with Canvas do
  561.                begin
  562.                     {Pen.Color:=MixColor;}
  563.                     Brush.Color:=MixColor;
  564.                     if Orientation = goHorizontal then
  565.                        {PolyLine([ Point(Rc.Left+i,Rc.Top), Point(Rc.Left+i,Rc.Bottom) ])}
  566.                        FillRect(Rect(Rc.Left+i, Rc.Top, Rc.Left+i+1, Rc.Bottom))
  567.                     else
  568.                         {PolyLine([ Point(Rc.Left, Rc.Top+i), Point(Rc.Right, Rc.Top+i) ]);}
  569.                         FillRect(Rect(Rc.Left, Rc.Top+i, Rc.Right, Rc.Top+i+1));
  570.                end;
  571.           end;
  572.      end;
  573. end;
  574.  
  575. function Minimum(Value1, Value2: Cardinal): Cardinal;
  576. begin
  577.      Result:=Value1;
  578.      if Value1 > Value2 then Result:=Value2;
  579. end;
  580.  
  581. {=============================================================================}
  582. { Public stuff for TPageList.                                                 }
  583. {=============================================================================}
  584.  
  585. destructor TPageList.Destroy;
  586. var
  587.    i: Integer;
  588.    Page: TPrintPage;
  589. begin
  590.      for i:=0 to Count-1 do
  591.      begin
  592.           Page:=GetPage(i);
  593.           if Page <> nil then Page.Free;
  594.      end;
  595.  
  596.      inherited Destroy;
  597. end;
  598.  
  599. function TPageList.GetPage(const Index: Integer): TPrintPage;
  600. begin
  601.      Result:=TPrintPage(Items[Index]);
  602. end;
  603.  
  604. {=============================================================================}
  605. { Public stuff for TPagePrinter.                                              }
  606. {=============================================================================}
  607.  
  608. constructor TPagePrinter.Create(Owner: TComponent);
  609. {$IFDEF PAGEPRINT_SHAREWARE}
  610. var
  611.    AboutBox: TPgPrnAboutBox;
  612. {$ENDIF}
  613. begin
  614.      fStillCreating:=True;
  615.      inherited Create(Owner);
  616. {$IFDEF PAGEPRINT_SHAREWARE}
  617.      AboutBox:=TPgPrnAboutBox.Create(Application);
  618.      try
  619.         AboutBox.ShowModal;
  620.      finally
  621.             AboutBox.Free;
  622.      end;
  623. {$ENDIF}
  624.      {We don't want a TPagePrinter to be a
  625.      container like normal TScrollBoxes can.}
  626.      ControlStyle := ControlStyle - [csAcceptsControls];
  627.      fUpdateRefCount:=0;
  628.  
  629.      fHeaderFont:=TFont.Create;
  630.      fFooterFont:=TFont.Create;
  631.      fLines := TStringList.Create;
  632.      {Make this explicitly nil so UpdateProgressDlg
  633.      can tell if it needs to Create or Free itself.}
  634.      fPPPrnPrgDlg := nil;
  635.      fCancelPrinting:=False;
  636.      {Setup the scrollbars.}
  637.      HorzScrollBar.Tracking:=True;
  638.      HorzScrollBar.Increment:=16;
  639.      VertScrollBar.Tracking:=True;
  640.      VertScrollBar.Increment:=16;
  641.  
  642.      fCurrentX:=0;
  643.      fCurrentY:=0;
  644.      fLineNumber:=0;
  645.      fPageNumber:=0;
  646.      fPrintingToFile:=False;
  647.      {It's hard to zero a non-typed variable...}
  648.      FillChar(fFileVar, sizeof(fFileVar), #0);
  649.  
  650.      {Keep our own pointer to the Printer object.}
  651.      fPrinter:=Printers.Printer;
  652.  
  653.      fTokenSeparator := '|';
  654.      fZoomPercent := 25;
  655.      fZoomLocation := zlTopLeft;
  656.      fPrinting := False;
  657.      fShadowOffset:=5;
  658.      fUsingTempPage:=True;
  659.      fDefaultColWidth:=1;
  660.  
  661.      {Setup the drawing surface.}
  662.      fPaintBox := TPaintBox.Create(Self);
  663.      fPaintBox.Parent := Self;
  664.      fPaintBox.Align := alClient;
  665.      fPaintBox.OnPaint:=PaintPreview;
  666.      {Setup the page list.}
  667.      ResetPageList(False);
  668.  
  669.      {Now setup the remaining properties which depend on the canvas.}
  670.      Font.Name := 'Courier New';
  671.      Font.Size := 10;
  672.      Font.Style := [];
  673.      HeaderFont:=Font;
  674.      FooterFont:=Font;
  675.      AutoHeaderFont:=True;
  676.      AutoFooterFont:=True;
  677.  
  678.      Width := 89;
  679.      Height := 115;
  680.      Orientation:=poPortrait;
  681.      Title:='';
  682.  
  683.      LineSpacing:=lsSingleSpace;
  684.      TabSize:=8;
  685.      WordWrap:=True;
  686.      Alignment:=taLeftJustify;
  687.      PageBorders:=[];
  688.      ShowProgress:=True;
  689.      ShowCancel:=True;
  690.      Header:='';
  691.      HeaderFormat:='';
  692.      Footer:='';
  693.      FooterFormat:='';
  694.      TableFormat:='';
  695.      PageBorderOffset:=0;
  696.      DefaultColWidth:=0;
  697.      MeasureUnit:=muInches;
  698.      TableGrid:=False;
  699.      PrintToFile:=False;
  700.      ShadowColor:=clBtnShadow;
  701.      ShowMargins:=True;
  702.      GradientBackground:=True;
  703.      Collate:=True;
  704.      Copies:=1;
  705.      PrintToPage:=0;
  706.      PrintFromPage:=0;
  707.      AbortOnCancel:=False;
  708.  
  709.      MarginTop:=GutterTop;
  710.      MarginBottom:=GutterBottom;
  711.      MarginLeft:=GutterLeft;
  712.      MarginRight:=GutterRight;
  713.  
  714.      fStillCreating:=False;
  715. end;
  716.  
  717. destructor TPagePrinter.Destroy;
  718. begin
  719.      FinishPrintPage;
  720.      fPaintBox.Free;
  721.      fLines.Free;
  722.      fPages.Free;
  723.      fHeaderFont.Free;
  724.      fFooterFont.Free;
  725.      inherited Destroy;
  726. end;
  727.  
  728. procedure TPagePrinter.Clear;
  729. begin
  730.      if not Printing then
  731.      begin
  732.           ResetPageList(False);
  733.           UpdatePagePreviewSize;
  734.           Invalidate;
  735.      end
  736.      else
  737.          raise EPagePrinter.Create('Can''t clear contents while printing');
  738. end;
  739.  
  740. procedure TPagePrinter.BeginDoc;
  741. begin
  742.      {Do this before we set printing to True}
  743.      {so it refreshes the margins too.}
  744.      RefreshProperties;
  745.      {Now we set the printing flag.}
  746.      fPrinting := True;
  747.      fPrintingHeaderOrFooter := False;
  748.      if PrintToFile then
  749.      begin
  750.           SetPixelsPerInch;
  751.           AssignFile(fFileVar, FileName);
  752.           Rewrite(fFileVar);
  753.           fPrintingToFile:=True;
  754.      end
  755.      else
  756.          ResetPageList(True);
  757.      {Make extra sure we get the Font.PixelsPerInch}
  758.      {property set correctly.}
  759.      SetPixelsPerInch;
  760.      fPageNumber:=1;
  761.      DoNewPageProcessing;
  762. end;
  763.  
  764. procedure TPagePrinter.EndDoc;
  765. begin
  766.      fPrinting := False;
  767.      if PrintToFile then
  768.      begin
  769.           CloseFile(fFileVar);
  770.           FillChar(fFileVar, sizeof(fFileVar), #0);
  771.           fPrintingToFile:=False;
  772.      end
  773.      else
  774.      begin
  775.           FinishPrintPage;
  776.           CreateTempPage;
  777.           PageNumber := 1;
  778.           UpdatePagePreviewSize;
  779.           Invalidate;
  780.      end;
  781. end;
  782.  
  783. function TPagePrinter.NewPage: Cardinal;
  784. begin
  785.      if fPrintingToFile then
  786.         Writeln(fFileVar, #12)
  787.      else
  788.          NewPrintPage;
  789.      Inc(fPageNumber);
  790.      DoNewPageProcessing;
  791.      Result:=PageNumber;
  792. end;
  793.  
  794. function TPagePrinter.NewLine: Cardinal;
  795. begin
  796.      fCurrentX:=0;
  797.      fCurrentY:=fCurrentY+fLineSpace;
  798.  
  799.      {See if the entire next line will fit.}
  800.      if (not fPrintingToFile) and (not fPrintingHeaderOrFooter) and
  801.         ((fCurrentY+fLineSpace) >= PixelPrintHeight) then
  802.          NewPage
  803.      else
  804.      begin
  805.           if fPrintingToFile then Writeln(fFileVar);
  806.           Inc(fLineNumber);
  807.      end;
  808.      {Fire the event handler if it exists.}
  809.      if Assigned(fOnNewLine) then fOnNewLine(Self);
  810.      Result:=LineNumber;
  811. end;
  812.  
  813. {This function returns whether it was successful.}
  814. function TPagePrinter.PrevLine: Boolean;
  815. begin
  816.      Result:=False;
  817.      if (fCurrentY >= fLineSpace) and not fPrintingToFile then
  818.      begin
  819.           fCurrentX:=0;
  820.           fCurrentY:=fCurrentY-fLineSpace;
  821.           Dec(fLineNumber);
  822.           Result:=True;
  823.      end;
  824. end;
  825.  
  826. procedure TPagePrinter.Write(const Line: String);
  827. var
  828.    LineWidth: TPixels;
  829.    Buffer: String;
  830. begin
  831.      if Pos(#9, Line)>0 then Buffer:=ExpandTabsAsSpaces(Line, TabSize)
  832.      else Buffer:=Line;
  833.  
  834.      LineWidth:=Canvas.TextWidth(Buffer);
  835.      if (LineWidth > (PixelPrintWidth-fCurrentX)) and (Length(Buffer) > 1) then
  836.      begin
  837.           if WordWrap then SplitLineAndPrint(Buffer, True)
  838.           else Write(GetClippedLine(Buffer, PixelPrintWidth-fCurrentX));
  839.      end
  840.      else
  841.      begin
  842.           {Make sure we don't write off the end of the page.}
  843.           if (fCurrentY+fLineSpace) >= PixelPrintHeight then
  844.              if not fPrintingToFile then NewPage;
  845.           {Now print the line.}
  846.           if fPrintingToFile then
  847.              System.Write(fFileVar, Buffer)
  848.           else
  849.               Canvas.TextOut(StartingLeft+fCurrentX, StartingTop+fCurrentY, Buffer);
  850.           fCurrentX:=fCurrentX+LineWidth;
  851.      end;
  852. end;
  853.  
  854. procedure TPagePrinter.WriteLine(const Line: String);
  855. var
  856.    LineWidth: TPixels;
  857.    Buffer: String;
  858. begin
  859.      if Pos(#9, Line)>0 then Buffer:=ExpandTabsAsSpaces(Line, TabSize)
  860.      else Buffer:=Line;
  861.  
  862.      LineWidth:=Canvas.TextWidth(Buffer);
  863.      if (LineWidth > PixelPrintWidth) and (Length(Buffer) > 1) then
  864.      begin
  865.           fCurrentX:=0;
  866.           if WordWrap then SplitLineAndPrint(Buffer, False)
  867.           else WriteLine(GetClippedLine(Buffer, PixelPrintWidth));
  868.      end
  869.      else
  870.      begin
  871.           case Alignment of
  872.                taRightJustify: fCurrentX := PixelPrintWidth-LineWidth;
  873.                taCenter: fCurrentX := (PixelPrintWidth-LineWidth) shr 1;
  874.           else
  875.               fCurrentX:=0;
  876.           end;
  877.           {Make sure we don't write off the end of the page.}
  878.           if (fCurrentY+fLineSpace) >= PixelPrintHeight then
  879.              if not fPrintingToFile then NewPage;
  880.           {Now print the line.}
  881.           if fPrintingToFile then //Put spaces in for alignment purposes.
  882.              Writeln(fFileVar, GenSpace(fCurrentX div Canvas.TextWidth(' '))+Buffer)
  883.           else
  884.               Canvas.TextOut(StartingLeft+fCurrentX, StartingTop+fCurrentY, Buffer);
  885.           NewLine;
  886.      end;
  887. end;
  888.  
  889. procedure TPagePrinter.WriteLineAligned(const AAlignment: TAlignment; const Line: String);
  890. var
  891.    OldAlign: TAlignment;
  892. begin
  893.      OldAlign:=Alignment;
  894.      try
  895.         Alignment:=AAlignment;
  896.         WriteLine(Line);
  897.      finally
  898.             Alignment:=OldAlign;
  899.      end;
  900. end;
  901.  
  902. procedure TPagePrinter.WriteTableLine(const Line: String);
  903. var
  904.    FormatTokens, LineTokens: TStringList;
  905.    i, CurWidth, LeftPos, Offset: Integer;
  906.    FloatCurWidth: TMeasurement;
  907.    CurAlignment: TAlignment;
  908.    CurToken, Buffer: String;
  909.    RepeatAgain, TopGrid, WriteGrid: Boolean;
  910.    {This local procedure sets up a lot of local variables.}
  911.    procedure WriteTableGridHelper(const i: Integer);
  912.    begin
  913.         {Get the Width and Alignment from the current column format.}
  914.         CurToken:=FormatTokens[i];
  915.         ParseFormatToken(CurToken, CurAlignment, FloatCurWidth);
  916.         WriteGrid:=TableGrid;
  917.         {Temporarily force the drawing of the Grid OFF}
  918.         if FloatCurWidth < 0 then WriteGrid:=False;
  919.         {Get the Absolute value of FloatCurWidth}
  920.         CurWidth:=MeasureUnitsToPixelsH(Abs(FloatCurWidth));
  921.    end;
  922. begin
  923.      FormatTokens:=TStringList.Create;
  924.      LineTokens:=TStringList.Create;
  925.      TopGrid:=TableGrid;
  926.  
  927.      try
  928.         TokenizeString(TableFormat, TokenSeparator, FormatTokens);
  929.         TokenizeString(Line, TokenSeparator, LineTokens);
  930.  
  931.         repeat
  932.               RepeatAgain:=False;
  933.               fCurrentX:=StartingLeft;
  934.               for i:=0 to FormatTokens.Count-1 do
  935.               begin
  936.                    {Set up a bunch of local variables within the local procedure.}
  937.                    WriteTableGridHelper(i);
  938.  
  939.                    {Now get a line token even if it's blank.}
  940.                    if i < LineTokens.Count then CurToken:=LineTokens[i]
  941.                    else CurToken:='';
  942.  
  943.                    (*Expand logical field names (e.g. {$LINE}).*)
  944.                    {The '{$' check is just to see if we can skip it.}
  945.                    if Pos('{$', CurToken) > 0 then
  946.                       CurToken:=ExpandLogicalFields(CurToken);
  947.  
  948.                    if WordWrap then
  949.                    begin
  950.                         {Determine just what will fit in the current column}
  951.                         Buffer:=CurToken;
  952.                         SplitLine(CurToken, Buffer, CurWidth, False);
  953.                         {Check if a forced line break is requested}
  954.                         LeftPos:=Pos(#10, CurToken);
  955.                         if LeftPos > 0 then
  956.                         begin
  957.                              if Length(Buffer) > 0 then Buffer:=' '+Buffer;
  958.                              Buffer:=Copy(CurToken, LeftPos+1, Length(CurToken))+Buffer;
  959.                              Delete(CurToken, LeftPos, Length(CurToken));
  960.                         end;
  961.                         if i < LineTokens.Count then LineTokens[i]:=Buffer;
  962.                         {Need to repeat loop if there is any unprinted text}
  963.                         if Length(Buffer) > 0 then RepeatAgain:=True;
  964.                    end
  965.                    else
  966.                        {Get just what will fit in the current column.}
  967.                        CurToken:=GetClippedLine(CurToken, CurWidth);
  968.  
  969.                    {Figure out where the X position will be in the current column.}
  970.                    case CurAlignment of
  971.                         taCenter: LeftPos:=(CurWidth-Canvas.TextWidth(CurToken)) shr 1;
  972.                         taRightJustify: LeftPos:=CurWidth-Canvas.TextWidth(CurToken);
  973.                    else
  974.                        LeftPos:=0;
  975.                    end;
  976.                    {We try to offset the text so it's not overlapping a grid border.}
  977.                    Offset:=3*DefaultBorderWidth*(GetDeviceCaps(fPrinter.Handle, LOGPIXELSX) div DefaultDPI);
  978.                    if Canvas.TextWidth(CurToken) < (CurWidth-Offset) then
  979.                       if CurAlignment = taRightJustify then LeftPos:=LeftPos - Offset
  980.                       else if CurAlignment = taLeftJustify then LeftPos:=LeftPos + Offset;
  981.  
  982.                    {Print out the current token.}
  983.                    if fPrintingToFile then
  984.                       System.Write(fFileVar, GenSpace(LeftPos div Canvas.TextWidth(' '))+CurToken+GenSpace((CurWidth-(LeftPos+Canvas.TextWidth(CurToken))) div Canvas.TextWidth(' ') ) )
  985.                    else
  986.                        Canvas.TextOut(fCurrentX+LeftPos, fCurrentY+StartingTop, CurToken);
  987.  
  988.                    {Draw the cell lines if necessary.}
  989.                    if WriteGrid then WriteTableGrid(CurWidth, TopGrid, False);
  990.                    {Increase fCurrentX by the COLUMN width.}
  991.                    fCurrentX:=fCurrentX+CurWidth;
  992.               end;
  993.               {Do not draw the top of the grid again}
  994.               TopGrid:=False;
  995.               if RepeatAgain then NewLine;
  996.         until RepeatAgain = False;
  997.  
  998.         {Draw the Bottom of the grid if necessary}
  999.         if TableGrid then
  1000.         begin
  1001.              fCurrentX:=StartingLeft;
  1002.              for i:=0 to FormatTokens.Count-1 do
  1003.              begin
  1004.                   {Set up a bunch of local variables within the local procedure.}
  1005.                   WriteTableGridHelper(i);
  1006.                   {Draw the cell lines if necessary.}                  
  1007.                   if WriteGrid then WriteTableGrid(CurWidth, False, True);
  1008.                   {Increase fCurrentX by the COLUMN width.}
  1009.                   fCurrentX:=fCurrentX+CurWidth;
  1010.              end;
  1011.         end;
  1012.      finally
  1013.             FormatTokens.Free;
  1014.             LineTokens.Free;
  1015.      end;
  1016.  
  1017.      {If we're not printing the Header or Footer, go to a new line.}
  1018.      {if ((fCurrentY >= 0) and (fCurrentY < PixelPrintHeight)) or}
  1019.      if (not fPrintingHeaderOrFooter) or fPrintingToFile then NewLine;
  1020. end;
  1021.  
  1022. procedure TPagePrinter.WriteTableGrid(const CurWidth: TPixels; const TopGrid, BottomGrid: Boolean);
  1023. var
  1024.    X, Y: Integer;
  1025. begin
  1026.      {Draw the cell lines.}
  1027.      X:=fCurrentX;
  1028.      Y:=fCurrentY+StartingTop;
  1029.      case LineSpacing of
  1030.           lsHalfSpace: Y:=Y-(fTextMetrics.tmExternalLeading shr 1);
  1031.           lsSingleSpace: Y:=Y-fTextMetrics.tmExternalLeading;
  1032.           lsSingleAndAHalf: Y:=Y-Round(fTextMetrics.tmExternalLeading*1.5);
  1033.           lsDoubleSpace: Y:=Y-(fTextMetrics.tmExternalLeading shl 1);
  1034.      end;
  1035.      {Draw the horizontal lines.}
  1036.      Canvas.Pen.Width:=DefaultBorderWidth*(GetDeviceCaps(fPrinter.Handle, LOGPIXELSY) div DefaultDPI);
  1037.      if TopGrid then
  1038.         Canvas.PolyLine([Point(X, Y), Point(X+CurWidth, Y)]);
  1039.      if BottomGrid then
  1040.         Canvas.PolyLine([Point(X, Y+fLineSpace), Point(X+CurWidth, Y+fLineSpace)]);
  1041.      {Draw the vertical lines.}
  1042.      Canvas.Pen.Width:=DefaultBorderWidth*(GetDeviceCaps(fPrinter.Handle, LOGPIXELSX) div DefaultDPI);
  1043.      Canvas.PolyLine([Point(X, Y), Point(X, Y+fLineSpace)]);
  1044.      Canvas.PolyLine([Point(X+CurWidth, Y), Point(X+CurWidth, Y+fLineSpace)]);
  1045. end;
  1046.  
  1047. procedure TPagePrinter.WriteLines(const LinesAsTable: Boolean);
  1048. var
  1049.    i: Integer; {This must allow negatives for Lines.Count-1}
  1050. begin
  1051.      for i:=0 to Lines.Count-1 do
  1052.      begin
  1053.           if LinesAsTable and (TableFormat<>'') then
  1054.              WriteTableLine(Lines[i])
  1055.           else
  1056.               WriteLine(Lines[i]);
  1057.      end;
  1058. end;
  1059.  
  1060. procedure TPagePrinter.RefreshProperties;
  1061. begin
  1062.      if not Printing then
  1063.      begin
  1064.           {Make sure the margins are correct for the current printer.}
  1065.           SetMarginTop(MarginTop);
  1066.           SetMarginBottom(MarginBottom);
  1067.           SetMarginLeft(MarginLeft);
  1068.           SetMarginRight(MarginRight);
  1069.      end;
  1070.      {Make sure the font gets sized correctly for the page.}
  1071.      GetTextMetrics(GetPrinterHandle, fTextMetrics);
  1072.      SetPixelsPerInch;
  1073.      {Make sure fLineSpace gets updated.}
  1074.      SetLineSpacing(LineSpacing);
  1075.      {Any column widths in friendly headers need to be recalculated}
  1076.      {now that we have a valid printer DC that we can get a DPI from.}
  1077.      {Also, any date and time fields need to be updated.}
  1078.      if FriendlyHeader <> '' then SetFriendlyHeader(FriendlyHeader);
  1079.      if FriendlyFooter <> '' then SetFriendlyFooter(FriendlyFooter);
  1080. end;
  1081.  
  1082. {=============================================================================}
  1083. { Private and Protected stuff for TPagePrinter.                               }
  1084. {=============================================================================}
  1085.  
  1086. procedure TPagePrinter.DoNewPageProcessing;
  1087. var
  1088.    PixelPageBorderOffset: TPixels;
  1089.    OldTableFormat: String;
  1090.    OldTableGrid, OldAutoHeaderFont, OldAutoFooterFont: Boolean;
  1091.    OldFont: TFont;
  1092.    CurX, CurY, CurLine: Integer;
  1093. begin
  1094.      {Reset the fields and fire new page event.}
  1095.      fCurrentX:=0;
  1096.      fCurrentY:=0;
  1097.      fLineNumber:=0;
  1098.      if Assigned(fOnNewPage) then fOnNewPage(Self);
  1099.  
  1100.      {Save these values in case OnNewPage modifies them.}
  1101.      CurX:=fCurrentX;
  1102.      CurY:=fCurrentY;
  1103.      CurLine:=fLineNumber;
  1104.      {Keep TableFormat because we temporarily
  1105.      change it for the Header and Footer.
  1106.      Similar for TableGrid.}
  1107.      OldTableFormat:=TableFormat;
  1108.      OldTableGrid:=TableGrid;
  1109.      TableGrid:=False;
  1110.      OldFont:=TFont.Create;
  1111.      OldFont.Assign(Font);
  1112.      OldAutoHeaderFont:=AutoHeaderFont;
  1113.      AutoHeaderFont:=False;
  1114.      OldAutoFooterFont:=AutoFooterFont;
  1115.      AutoFooterFont:=False;
  1116.      fPrintingHeaderOrFooter:=True;
  1117.      {I'm trying to center the header and footer between
  1118.       the top of the page and the PageBorders.}
  1119.      try
  1120.         {Print the header.}
  1121.         if Header <> '' then
  1122.         begin
  1123.              Font.Assign(HeaderFont);
  1124.              {fCurrentY should be negative here since we're drawing above the top margin.}
  1125.              //TLinePrinter way: fCurrentY:=((StartingTop-fLineSpace) shr 1)-StartingTop;
  1126.              if pbTop in PageBorders then
  1127.                 fCurrentY:=((MeasureUnitsToPixelsV(MarginTop-PageBorderOffset)-fLineSpace) shr 1)-MeasureUnitsToPixelsV(MarginTop)
  1128.              else
  1129.                  fCurrentY:=((MeasureUnitsToPixelsV(MarginTop)-fLineSpace) shr 1)-MeasureUnitsToPixelsV(MarginTop);
  1130.              if (fCurrentY + StartingTop) < 0 then fCurrentY := -1*StartingTop;
  1131.              TableFormat:=HeaderFormat;
  1132.              WriteTableLine(Header);
  1133.         end;
  1134.  
  1135.         {Print the footer.}
  1136.         if Footer <> '' then
  1137.         begin
  1138.              Font.Assign(FooterFont);
  1139.              //TLinePrinter Way: fCurrentY:=PixelPrintHeight+((StartingBottom-fLineSpace) shr 1);
  1140.              if pbBottom in PageBorders then
  1141.                 fCurrentY:=PixelPrintHeight+MeasureUnitsToPixelsV(PageBorderOffset)+((MeasureUnitsToPixelsV(MarginBottom-PageBorderOffset)-fLineSpace) shr 1)
  1142.              else
  1143.                  fCurrentY:=PixelPrintHeight+((MeasureUnitsToPixelsV(MarginBottom)-fLineSpace) shr 1);
  1144.              if (StartingTop+fCurrentY+fLineSpace) > MeasureUnitsToPixelsV(AvailablePageHeight) then
  1145.                 fCurrentY:=MeasureUnitsToPixelsV(AvailablePageHeight)-StartingTop-fLineSpace;
  1146.              TableFormat:=FooterFormat;
  1147.              WriteTableLine(Footer);
  1148.         end;
  1149.      finally
  1150.             fPrintingHeaderOrFooter:=False;
  1151.             {Restore the original values.}
  1152.             TableFormat:=OldTableFormat;
  1153.             TableGrid:=OldTableGrid;
  1154.             Font.Assign(OldFont);
  1155.             OldFont.Free;
  1156.             {I'm intentionally setting the private fields here.}
  1157.             fAutoHeaderFont:=OldAutoHeaderFont;
  1158.             fAutoFooterFont:=OldAutoFooterFont;
  1159.      end;
  1160.  
  1161.      {We must reset these here because printing the header and footer modifies them.}
  1162.      fCurrentX:=CurX;
  1163.      fCurrentY:=CurY;
  1164.      fLineNumber:=CurLine;
  1165.      {Fire the OnNewLine event for the first line on the page.}
  1166.      if Assigned(fOnNewLine) then fOnNewLine(Self);
  1167.  
  1168.      {Print the PageBorders.}
  1169.      with Canvas do
  1170.      begin
  1171.           Pen.Width:=DefaultBorderWidth*(GetDeviceCaps(fPrinter.Handle, LOGPIXELSY) div DefaultDPI);
  1172.           PixelPageBorderOffset:=MeasureUnitsToPixelsV(PageBorderOffset);
  1173.           if pbTop in PageBorders then
  1174.           begin
  1175.                MoveTo(StartingLeft-PixelPageBorderOffset,StartingTop-PixelPageBorderOffset);
  1176.                LineTo(StartingLeft+PixelPrintWidth+PixelPageBorderOffset, StartingTop-PixelPageBorderOffset);
  1177.           end;
  1178.           if pbBottom in PageBorders then
  1179.           begin
  1180.                MoveTo(StartingLeft-PixelPageBorderOffset, StartingTop+PixelPrintHeight+PixelPageBorderOffset);
  1181.                LineTo(StartingLeft+PixelPrintWidth+PixelPageBorderOffset, StartingTop+PixelPrintHeight+PixelPageBorderOffset);
  1182.           end;
  1183.  
  1184.           Pen.Width:=DefaultBorderWidth*(GetDeviceCaps(fPrinter.Handle, LOGPIXELSX) div DefaultDPI);
  1185.           PixelPageBorderOffset:=MeasureUnitsToPixelsH(PageBorderOffset);
  1186.           if pbLeft in PageBorders then
  1187.           begin
  1188.                MoveTo(StartingLeft-PixelPageBorderOffset, StartingTop-PixelPageBorderOffset);
  1189.                LineTo(StartingLeft-PixelPageBorderOffset, StartingTop+PixelPrintHeight+PixelPageBorderOffset);
  1190.           end;
  1191.           if pbRight in PageBorders then
  1192.           begin
  1193.                MoveTo(StartingLeft+PixelPrintWidth+PixelPageBorderOffset, StartingTop-PixelPageBorderOffset);
  1194.                LineTo(StartingLeft+PixelPrintWidth+PixelPageBorderOffset, StartingTop+PixelPrintHeight+PixelPageBorderOffset);
  1195.           end;
  1196.      end;
  1197. end;
  1198.  
  1199. procedure TPagePrinter.SplitLine(var CurLine: String; var Buffer: String; const ClipWidth: TPixels; const TrimLastWhiteSpace: Boolean);
  1200. var
  1201.    Len: Cardinal;
  1202. begin
  1203.      CurLine:=GetClippedLine(Buffer, ClipWidth);
  1204.      Len:=Length(CurLine);
  1205.      {If the next character isn't whitespace, slide back to the nearest.
  1206.      Also, like most word processors do, I'm going to delete the
  1207.      first leading whitespace character left in the next-line buffer after
  1208.      the delete/newline (if one exists).}
  1209.      if Len<Length(Buffer) then
  1210.      begin
  1211.           if not (Buffer[Len+1] in [#0..#32]) then
  1212.           begin
  1213.                CurLine:=StripBackToWhiteSpace(CurLine);
  1214.                Len:=Length(CurLine);
  1215.           end
  1216.           else
  1217.               if TrimLastWhiteSpace then Inc(Len);
  1218.      end;
  1219.      Delete(Buffer, 1, Len);
  1220. end;
  1221.  
  1222. procedure TPagePrinter.SplitLineAndPrint(const Line: String; UseWrite: Boolean);
  1223. var
  1224.    Buffer, CurLine: String;
  1225. begin
  1226.      Buffer:=Line;
  1227.      repeat
  1228.            SplitLine(CurLine, Buffer, PixelPrintWidth-fCurrentX, not UseWrite);
  1229.            if UseWrite then
  1230.            begin
  1231.                 Write(CurLine);
  1232.                 if Length(Buffer) > 0 then NewLine;
  1233.            end
  1234.            else
  1235.                WriteLine(CurLine);
  1236.      until Buffer='';
  1237. end;
  1238.  
  1239. function TPagePrinter.GetClippedLine(const Line: String; const Width: TPixels): String;
  1240. var
  1241.    PixelLen: TPixels;
  1242.    StartPos, EndPos, Mid, PreviousMid: Cardinal;
  1243. begin
  1244.      PixelLen:=Canvas.TextWidth(Line);
  1245.      if PixelLen > Width then
  1246.      begin
  1247.           EndPos:=Length(Line);
  1248.           StartPos:=1;
  1249.           Mid:=0;
  1250.           repeat
  1251.                 PreviousMid:=Mid;
  1252.                 Mid:=(StartPos+EndPos) shr 1;
  1253.                 PixelLen:=Canvas.TextWidth(Copy(Line,1,Mid));
  1254.  
  1255.                 if PixelLen > Width then EndPos:=Mid
  1256.                 else if PixelLen < Width then StartPos:=Mid
  1257.                 else StartPos:=EndPos;
  1258.           until (Mid=PreviousMid) or (StartPos>=EndPos);
  1259.           Result:=Copy(Line, 1, Mid);
  1260.      end
  1261.      else
  1262.          Result:=Line;
  1263. end;
  1264.  
  1265. function TPagePrinter.PixelPrintWidth: TPixels;
  1266. begin
  1267.      try
  1268.         Result:=MeasureUnitsToPixelsH(AvailablePageWidth)-StartingLeft-StartingRight;
  1269.      except
  1270.            on ERangeError do Result:=0;
  1271.      end;
  1272. end;
  1273.  
  1274. function TPagePrinter.PixelPrintHeight: TPixels;
  1275. begin
  1276.      try
  1277.         Result:=MeasureUnitsToPixelsV(AvailablePageHeight)-StartingTop-StartingBottom;
  1278.      except
  1279.            on ERangeError do Result:=0;
  1280.      end;
  1281. end;
  1282.  
  1283. function TPagePrinter.GetTitle: String;
  1284. begin
  1285.      try
  1286.         Result:=fPrinter.Title;
  1287.      except
  1288.            on EPrinter do Result:='<Unknown>';
  1289.      end;
  1290. end;
  1291.  
  1292. procedure TPagePrinter.SetTitle(Value: String);
  1293. begin
  1294.      try
  1295.         fPrinter.Title:=Value
  1296.      except
  1297.            on EPrinter do ;
  1298.      end;
  1299. end;
  1300.  
  1301. function TPagePrinter.GetOrientation: TPrinterOrientation;
  1302. begin
  1303.      try
  1304.         Result:=fPrinter.Orientation;
  1305.      except
  1306.            on EPrinter do Result:=poPortrait;
  1307.      end;
  1308. end;
  1309.  
  1310. procedure TPagePrinter.SetOrientation(Value: TPrinterOrientation);
  1311. begin
  1312.      if not Printing then
  1313.      begin
  1314.           try
  1315.              fPrinter.Orientation:=Value;
  1316.           except
  1317.                 on EPrinter do ;
  1318.           end;
  1319.           UpdatePagePreviewSize;
  1320.           Invalidate;
  1321.      end
  1322.      else
  1323.          raise EPagePrinter.Create('Unable to change orientation while printing');
  1324. end;
  1325.  
  1326. function TPagePrinter.GetAvailablePageHeight: TMeasurement;
  1327. begin
  1328.      try
  1329. {$IFDEF USE_SYMMETRIC_GUTTERS}
  1330.         Result:=PhysicalPageHeight-GutterTop-GutterBottom;
  1331. {$ELSE}
  1332.         Result:=PixelsToMeasureUnitsV(GetDeviceCaps(fPrinter.Handle, VERTRES));
  1333. {$ENDIF}
  1334.      except
  1335.         on EPrinter do
  1336.            if MeasureUnit = muInches then Result:=DefaultAvailablePageHeightIn
  1337.            else Result:=DefaultAvailablePageHeightMm;
  1338.      end;
  1339. end;
  1340.  
  1341. function TPagePrinter.GetAvailablePageWidth: TMeasurement;
  1342. begin
  1343.      try
  1344. {$IFDEF USE_SYMMETRIC_GUTTERS}
  1345.         Result:=PhysicalPageWidth-GutterLeft-GutterRight;
  1346. {$ELSE}
  1347.         Result:=PixelsToMeasureUnitsH(GetDeviceCaps(fPrinter.Handle, HORZRES));
  1348. {$ENDIF}
  1349.      except
  1350.         on EPrinter do
  1351.            if MeasureUnit = muInches then Result:=DefaultAvailablePageWidthIn
  1352.            else Result:=DefaultAvailablePageWidthMm;
  1353.      end;
  1354. end;
  1355.  
  1356. function TPagePrinter.GetPageNumber: Cardinal;
  1357. begin
  1358.      Result:=fPageNumber;
  1359. end;
  1360.  
  1361. function TPagePrinter.GetPrinting: Boolean;
  1362. begin
  1363.      if PrintToFile then
  1364.         Result:=fPrintingToFile
  1365.      else
  1366.          Result:=fPrinting;
  1367. end;
  1368.  
  1369. procedure TPagePrinter.SetPixelsPerInch;
  1370. var
  1371.    FontSize: Integer;
  1372. begin
  1373.      {This routine gets us around the Delphi tiny font bug.}
  1374.      FontSize := Canvas.Font.Size;
  1375.      try
  1376.         Canvas.Font.PixelsPerInch := GetDeviceCaps(fPrinter.Handle, LOGPIXELSY);
  1377.      except
  1378.            on EPrinter do Canvas.Font.PixelsPerInch:=DefaultDPI;
  1379.      end;
  1380.      if FontSize < 144 then
  1381.         Canvas.Font.Size := FontSize + 1
  1382.      else
  1383.          Canvas.Font.Size := FontSize - 1;
  1384.      Canvas.Font.Size := FontSize;
  1385. end;
  1386.  
  1387. procedure TPagePrinter.SetMarginTop(Value: TMeasurement);
  1388. begin
  1389.      if not Printing then
  1390.      begin
  1391.           if Value >= GutterTop then
  1392.           begin
  1393.                if Value <= (PhysicalPageHeight-GutterBottom) then fMarginTop:=Value
  1394.                else
  1395.                begin
  1396.                     fMarginTop:=PhysicalPageHeight-GutterBottom;
  1397.                end;
  1398.           end
  1399.           else
  1400.               fMarginTop:=GutterTop;
  1401.           Invalidate;
  1402.      end
  1403.      else raise EPagePrinter.Create('Unable to change top margin while printing');
  1404. end;
  1405.  
  1406. procedure TPagePrinter.SetMarginBottom(Value: TMeasurement);
  1407. begin
  1408.      if not Printing then
  1409.      begin
  1410.           if Value >= GutterBottom then
  1411.           begin
  1412.                if Value <= (PhysicalPageHeight-GutterTop) then fMarginBottom:=Value
  1413.                else
  1414.                begin
  1415.                     fMarginBottom:=PhysicalPageHeight-GutterTop;
  1416.                end;
  1417.           end
  1418.           else
  1419.               fMarginBottom:=GutterBottom;
  1420.           Invalidate;
  1421.      end
  1422.      else raise EPagePrinter.Create('Unable to change bottom margin while printing');
  1423. end;
  1424.  
  1425. procedure TPagePrinter.SetMarginLeft(Value: TMeasurement);
  1426. begin
  1427.      if not Printing then
  1428.      begin
  1429.           if Value >= GutterLeft then
  1430.           begin
  1431.                if Value <= (PhysicalPageWidth-GutterRight) then fMarginLeft:=Value
  1432.                else
  1433.                begin
  1434.                     fMarginLeft:=PhysicalPageWidth-GutterRight;
  1435.                end;
  1436.           end
  1437.           else
  1438.               fMarginLeft:=GutterLeft;
  1439.           Invalidate;
  1440.      end
  1441.      else raise EPagePrinter.Create('Unable to change left margin while printing');
  1442. end;
  1443.  
  1444. procedure TPagePrinter.SetMarginRight(Value: TMeasurement);
  1445. begin
  1446.      if not Printing then
  1447.      begin
  1448.           if Value >= GutterRight then
  1449.           begin
  1450.                if Value < (PhysicalPageWidth-GutterLeft) then fMarginRight:=Value
  1451.                else
  1452.                begin
  1453.                     fMarginRight:=PhysicalPageWidth-GutterLeft;
  1454.                end;
  1455.           end
  1456.           else
  1457.               fMarginRight:=GutterRight;
  1458.           Invalidate;
  1459.      end
  1460.      else raise EPagePrinter.Create('Unable to change right margin while printing');
  1461. end;
  1462.  
  1463. procedure TPagePrinter.SetMeasureUnit(Value: TMeasureUnit);
  1464. begin
  1465.      if Value <> fMeasureUnit then
  1466.      begin
  1467.           fMeasureUnit:=Value;
  1468.           if not fStillCreating then
  1469.           begin
  1470.                { Update the measurements if the units have changed.}
  1471.                if MeasureUnit = muInches then
  1472.                begin
  1473.                     MarginTop:=MarginTop/25.4;
  1474.                     MarginBottom:=MarginBottom/25.4;
  1475.                     MarginLeft:=MarginLeft/25.4;
  1476.                     MarginRight:=MarginRight/25.4;
  1477.                     PageBorderOffset:=PageBorderOffset/25.4;
  1478.                     DefaultColWidth:=DefaultColWidth/25.4;
  1479.                end
  1480.                else
  1481.                begin
  1482.                     MarginTop:=MarginTop*25.4;
  1483.                     MarginBottom:=MarginBottom*25.4;
  1484.                     MarginLeft:=MarginLeft*25.4;
  1485.                     MarginRight:=MarginRight*25.4;
  1486.                     PageBorderOffset:=PageBorderOffset*25.4;
  1487.                     DefaultColWidth:=DefaultColWidth*25.4;
  1488.                end;
  1489.                RefreshProperties;
  1490.                if FriendlyFooter = '' then fFooterFormat:=ValidateFormatString(FooterFormat, True);
  1491.                if FriendlyHeader = '' then fHeaderFormat:=ValidateFormatString(HeaderFormat, True);
  1492.                fTableFormat:=ValidateFormatString(TableFormat, True);
  1493.           end;
  1494.      end;
  1495. end;
  1496.  
  1497. procedure TPagePrinter.SetLineSpacing(Value: TLineSpacing);
  1498. var
  1499.    H: TPixels;
  1500. begin
  1501.      fLineSpacing:=Value;
  1502.      H:=Abs(Canvas.Font.Height);
  1503.      case Value of
  1504.           lsHalfSpace: fLineSpace:=H shr 1;
  1505.           lsSingleSpace: fLineSpace:=H;
  1506.           lsSingleAndAHalf: fLineSpace:=H+(H shr 1);
  1507.           lsDoubleSpace: fLineSpace:=H+H;
  1508.      end;
  1509. end;
  1510.  
  1511. function TPagePrinter.GetLines: TStrings;
  1512. begin
  1513.      {I have to do Check/Create here because C++Builder}
  1514.      {1.0 kept giving access violations if I didn't...}
  1515.      if fLines = nil then
  1516.         fLines := TStringList.Create;
  1517.      GetLines := fLines;
  1518. end;
  1519.  
  1520. procedure TPagePrinter.SetLines(Value: TStrings);
  1521. begin
  1522.      if Value = nil then
  1523.      begin
  1524.           fLines.Free;
  1525.           fLines := nil;
  1526.           Exit;
  1527.      end;
  1528.      Lines.Assign(Value);
  1529. end;
  1530.  
  1531. procedure TPagePrinter.SetDefaultColWidth(Value: TMeasurement);
  1532. begin
  1533.      fDefaultColWidth:=Value;
  1534. end;
  1535.  
  1536. procedure TPagePrinter.UpdateProgressDlg(const Status: String; const CurrentPage, FromPage, ToPage: Cardinal);
  1537. const
  1538.      DefaultProgClientHeight = 98;
  1539. begin
  1540.      if ShowProgress and (Status <> ProgressFinishMsg) then
  1541.      begin
  1542.           {Create it if is doesn't already exist.}
  1543.           if fPPPrnPrgDlg = nil then
  1544.           begin
  1545.                fPPPrnPrgDlg:=TPPPrnPrgDlg.Create(Application);
  1546.                {Set the cancel event handler.}
  1547.                fPPPrnPrgDlg.btnCancel.OnClick:=OnCancelPrinting;
  1548.                {Hide the cancel button if necessary.}
  1549.                if not ShowCancel then
  1550.                begin
  1551.                     fPPPrnPrgDlg.btnCancel.Enabled:=False;
  1552.                     fPPPrnPrgDlg.btnCancel.Visible:=False;
  1553.                     fPPPrnPrgDlg.ClientHeight:=(DefaultProgClientHeight*fPPPrnPrgDlg.PixelsPerInch) div 96;
  1554.                end;
  1555.           end;
  1556.           {Show it and bring it to the front.}
  1557.           fPPPrnPrgDlg.Show;
  1558.           {Update it as necessary.}
  1559.           with fPPPrnPrgDlg do
  1560.           begin
  1561.                Caption:=Title;
  1562.                if Status = '' then
  1563.                   lblStatus.Caption:=SendingPagesMsg
  1564.                else
  1565.                    lblStatus.Caption:=Status;
  1566.                ProgBar.Max:=Copies*(ToPage-FromPage+1);
  1567.                ProgBar.StepIt;
  1568.                lblPageNumber.Caption:='Page '+IntToStr(CurrentPage);
  1569.                if FromPage = 1 then
  1570.                begin
  1571.                     lblPageNumber.Caption:=lblPageNumber.Caption+' of '+IntToStr(ToPage-FromPage+1);
  1572.                     if Copies > 1 then
  1573.                        lblPageNumber.Caption:=lblPageNumber.Caption+' x '+IntToStr(Copies)+' Copies';
  1574.                end;
  1575.                if Showing then Update;
  1576.           end;
  1577.      end
  1578.      else
  1579.      begin
  1580.           {If it exists, get rid of it.}
  1581.           if fPPPrnPrgDlg <> nil then
  1582.           begin
  1583.                {If it is visible, close it.}
  1584.                if fPPPrnPrgDlg.Visible then fPPPrnPrgDlg.Close;
  1585.                fPPPrnPrgDlg.Free;
  1586.                fPPPrnPrgDlg := nil;
  1587.           end;
  1588.      end;
  1589. end;
  1590.  
  1591. function TPagePrinter.GetGutterTop: TMeasurement;
  1592. begin
  1593.      try
  1594.         Result:=PixelsToMeasureUnitsV(GetDeviceCaps(fPrinter.Handle, PHYSICALOFFSETY));
  1595.      except
  1596.         on EPrinter do
  1597.            if MeasureUnit = muInches then Result:=DefaultGutterTopIn
  1598.            else Result:=DefaultGutterTopMm;
  1599.      end;
  1600. end;
  1601.  
  1602. function TPagePrinter.GetGutterBottom: TMeasurement;
  1603. begin
  1604. {$IFDEF USE_SYMMETRIC_GUTTERS}
  1605.      Result:=GutterTop;
  1606. {$ELSE}
  1607.      Result:=PhysicalPageHeight-AvailablePageHeight-GutterTop;
  1608. {$ENDIF}
  1609. end;
  1610.  
  1611. function TPagePrinter.GetGutterLeft: TMeasurement;
  1612. begin
  1613.      try
  1614.         Result:=PixelsToMeasureUnitsH(GetDeviceCaps(fPrinter.Handle, PHYSICALOFFSETX));
  1615.      except
  1616.         on EPrinter do
  1617.            if MeasureUnit = muInches then Result:=DefaultGutterLeftIn
  1618.            else Result:=DefaultGutterLeftMm;
  1619.      end;
  1620. end;
  1621.  
  1622. function TPagePrinter.GetGutterRight: TMeasurement;
  1623. begin
  1624. {$IFDEF USE_SYMMETRIC_GUTTERS}
  1625.      Result:=GutterLeft;
  1626. {$ELSE}
  1627.      Result:=PhysicalPageWidth-AvailablePageWidth-GutterLeft;
  1628. {$ENDIF}
  1629. end;
  1630.  
  1631. function TPagePrinter.StartingLeft: TPixels;
  1632. begin
  1633.      Result:=MeasureUnitsToPixelsH(MarginLeft-GutterLeft);
  1634. end;
  1635.  
  1636. function TPagePrinter.StartingRight: TPixels;
  1637. begin
  1638.      Result:=MeasureUnitsToPixelsH(MarginRight-GutterRight);
  1639. end;
  1640.  
  1641. function TPagePrinter.StartingTop: TPixels;
  1642. begin
  1643.      Result:=MeasureUnitsToPixelsV(MarginTop-GutterTop);
  1644. end;
  1645.  
  1646. function TPagePrinter.StartingBottom: TPixels;
  1647. begin
  1648.      Result:=MeasureUnitsToPixelsV(MarginBottom-GutterBottom);
  1649. end;
  1650.  
  1651. function TPagePrinter.MeasureUnitsToPixelsH(const M: TMeasurement): TPixels;
  1652. var
  1653.   Temp: TMeasurement;
  1654. begin
  1655.      Temp := M;
  1656.      try
  1657.         if MeasureUnit = muMillimeters then Temp := M / 25.4;
  1658.         Result:=Round((Temp*GetDeviceCaps(fPrinter.Handle, LOGPIXELSX)));
  1659.      except
  1660.            on EPrinter do Result:=Round(Temp*DefaultDPI);
  1661.      end;
  1662. end;
  1663.  
  1664. function TPagePrinter.MeasureUnitsToPixelsV(const M: TMeasurement): TPixels;
  1665. var
  1666.   Temp: TMeasurement;
  1667. begin
  1668.      Temp := M;
  1669.      try
  1670.         if MeasureUnit = muMillimeters then Temp := M / 25.4;
  1671.         Result:=Round((Temp*GetDeviceCaps(fPrinter.Handle, LOGPIXELSY)));
  1672.      except
  1673.            on EPrinter do Result:=Round(Temp*DefaultDPI);
  1674.      end;
  1675. end;
  1676.  
  1677. function TPagePrinter.PixelsToMeasureUnitsH(const P: TPixels): TMeasurement;
  1678. begin
  1679.      try
  1680.         Result:=(P / GetDeviceCaps(fPrinter.Handle, LOGPIXELSX));
  1681.      except
  1682.            on EZeroDivide do Result:=P/DefaultDPI;
  1683.            on EPrinter do Result:=P/DefaultDPI;
  1684.      end;
  1685.      if MeasureUnit = muMillimeters then Result:=Result*25.4;
  1686. end;
  1687.  
  1688. function TPagePrinter.PixelsToMeasureUnitsV(const P: TPixels): TMeasurement;
  1689. begin
  1690.      try
  1691.         Result:=(P / GetDeviceCaps(fPrinter.Handle, LOGPIXELSY));
  1692.      except
  1693.            on EZeroDivide do Result:=P/DefaultDPI;
  1694.            on EPrinter do Result:=P/DefaultDPI;
  1695.      end;
  1696.      if MeasureUnit = muMillimeters then Result:=Result*25.4;
  1697. end;
  1698.  
  1699. procedure TPagePrinter.ParseFormatToken(var CurToken: String; var CurAlignment: TAlignment;
  1700.           var CurWidth: TMeasurement);
  1701. begin
  1702.      if CurToken = '' then CurToken:='<'+FloatToStr(DefaultColWidth);
  1703.      if Length(CurToken) = 1 then
  1704.         if (CurToken[1] in ['<', '^', '>']) then CurToken:=CurToken+FloatToStr(DefaultColWidth);
  1705.  
  1706.      {Alignment}
  1707.      case CurToken[1] of
  1708.           '<': begin
  1709.                     CurAlignment:=taLeftJustify;
  1710.                     Delete(CurToken, 1, 1);
  1711.                end;
  1712.           '^': begin
  1713.                     CurAlignment:=taCenter;
  1714.                     Delete(CurToken, 1, 1);
  1715.                end;
  1716.           '>': begin
  1717.                     CurAlignment:=taRightJustify;
  1718.                     Delete(CurToken, 1, 1);
  1719.                end;
  1720.      else
  1721.          CurAlignment:=taLeftJustify;
  1722.      end;
  1723.  
  1724.      {Width}
  1725.      try
  1726.         CurWidth:=StrToFloat(CurToken);
  1727.      except
  1728.            on EConvertError do CurWidth:=DefaultColWidth;
  1729.      end;
  1730. end;
  1731.  
  1732. function TPagePrinter.ExpandLogicalFields(S: String): String;
  1733. begin
  1734.      S:=ReplaceSubString(LineField, IntToStr(LineNumber), S);
  1735.      S:=ReplaceSubString(PageField, IntToStr(PageNumber), S);
  1736.      S:=ReplaceSubString(DateField, FormatDateTime('ddddd',Date), S);
  1737.      S:=ReplaceSubString(TimeField, FormatDateTime('tt',Time), S);
  1738.      S:=ReplaceSubString(TitleField, Title, S);
  1739.      Result:=S;
  1740. end;
  1741.  
  1742. procedure TPagePrinter.SetPageBorderOffset(Value: TMeasurement);
  1743. begin
  1744.      fPageBorderOffset:=Value;
  1745. end;
  1746.  
  1747. function TPagePrinter.GetPhysicalPageHeight: TMeasurement;
  1748. begin
  1749.      try
  1750.         Result:=PixelsToMeasureUnitsV(GetDeviceCaps(fPrinter.Handle, PHYSICALHEIGHT));
  1751.      except
  1752.         on EPrinter do
  1753.            if MeasureUnit = muInches then Result:=DefaultPhysicalPageHeightIn
  1754.            else Result:=DefaultPhysicalPageHeightMm;
  1755.      end;
  1756. end;
  1757.  
  1758. function TPagePrinter.GetPhysicalPageWidth: TMeasurement;
  1759. begin
  1760.      try
  1761.         Result:=PixelsToMeasureUnitsH(GetDeviceCaps(fPrinter.Handle, PHYSICALWIDTH));
  1762.      except
  1763.         on EPrinter do
  1764.            if MeasureUnit = muInches then Result:=DefaultPhysicalPageWidthIn
  1765.            else Result:=DefaultPhysicalPageWidthMm;
  1766.      end;
  1767. end;
  1768.  
  1769. function TPagePrinter.GetPrintableWidth: TMeasurement;
  1770. begin
  1771.      Result:=PhysicalPageWidth-MarginLeft-MarginRight;
  1772. end;
  1773.  
  1774. function TPagePrinter.GetPrintableHeight: TMeasurement;
  1775. begin
  1776.      Result:=PhysicalPageHeight-MarginTop-MarginBottom;
  1777. end;
  1778.  
  1779. procedure TPagePrinter.SetPrintToFile(Value: Boolean);
  1780. begin
  1781.      if Value <> fPrintToFile then
  1782.      begin
  1783.           if not Printing then
  1784.           begin
  1785.                fPrintToFile:=Value;
  1786.           end
  1787.           else
  1788.               raise EPagePrinter.Create('Can''t change PrintToFile while printing');
  1789.      end;
  1790. end;
  1791.  
  1792. function TPagePrinter.GetFileName: String;
  1793. begin
  1794.      Result:=fFileName;
  1795. end;
  1796.  
  1797. procedure TPagePrinter.SetFileName(Value: String);
  1798. begin
  1799.      if Value <> fFileName then
  1800.      begin
  1801.           if not Printing then
  1802.           begin
  1803.                fFileName:=Trim(Value);
  1804.           end
  1805.           else
  1806.               raise EPagePrinter.Create('Can''t change FileName while printing');
  1807.      end;
  1808. end;
  1809.  
  1810. { New stuff for TPagePrinter}
  1811.  
  1812. function TPagePrinter.MeasureUnitsToScreenPixels(const Value: TMeasurement; Horz: Boolean): TPixels;
  1813. var
  1814.    Temp: TMeasurement;
  1815.    Index: Integer;
  1816. begin
  1817.      Temp := Value;
  1818.      if MeasureUnit = muMillimeters then Temp := Value / 25.4;
  1819.      if Horz then Index:=LOGPIXELSX else Index:=LOGPIXELSY;
  1820.      if not fStillCreating then
  1821.         Result:=Round(Temp*GetDeviceCaps(fPaintBox.Canvas.Handle, Index))
  1822.      else
  1823.          Result:=Round(Temp*Screen.PixelsPerInch);
  1824. end;
  1825.  
  1826. function TPagePrinter.ScaleValue(Value: TMeasurement; Horz: Boolean): TPixels;
  1827. begin
  1828.      Result:=MeasureUnitsToScreenPixels(Value, Horz);
  1829.      Result:=Round((Result*ZoomPercent)/100);
  1830. end;
  1831.  
  1832. procedure TPagePrinter.PaintPreview(Sender: TObject);
  1833. var
  1834.    PagePixelsWidth, PagePixelsHeight: TPixels;
  1835.    XOffset, YOffset: Integer;
  1836.    R, MarginRect: TRect;
  1837. begin
  1838.      if GradientBackground then
  1839.      begin
  1840.           {At some point in the future I'd like to use the new Win32 Gradient APIs...}
  1841.           FillGradient( fPaintBox.Canvas, fPaintBox.ClientRect,
  1842.                         clBlack, Color, goVertical);
  1843.      end;
  1844.  
  1845.      with fPaintBox.Canvas do
  1846.      begin
  1847.           PagePixelsHeight:=GetPreviewPagePixelsV;
  1848.           PagePixelsWidth:=GetPreviewPagePixelsH;
  1849.           {Calculate the page area.}
  1850.           XOffset:=(fPaintBox.Width - PagePixelsWidth) div 2;
  1851.           YOffset:=(fPaintBox.Height - PagePixelsHeight) div 2;
  1852.           R.Left := XOffset;
  1853.           R.Top := YOffset;
  1854.           R.Right := PagePixelsWidth+XOffset;
  1855.           R.Bottom := PagePixelsHeight+YOffset;
  1856.           MarginRect:=R; //Save this for later.
  1857.           Pen.Style := psSolid;
  1858.           if ShadowOffset > 0 then
  1859.           begin
  1860.                {Draw the shadow.}
  1861.                Brush.Color := ShadowColor;
  1862.                Pen.Color := ShadowColor;
  1863.                {Right Portion}
  1864.                Rectangle(R.Left+PagePixelsWidth, R.Top+ShadowOffset,
  1865.                      R.Right+ShadowOffset, R.Bottom+ShadowOffset);
  1866.                {Bottom Portion}
  1867.                Rectangle(R.Left+ShadowOffset, R.Top+PagePixelsHeight,
  1868.                      R.Right, R.Bottom+ShadowOffset);
  1869.           end;
  1870.           {Draw the page.}
  1871.           Brush.Color := clWhite;
  1872.           Pen.Color := clBlack;
  1873.           Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  1874.  
  1875.           {Draw the current page on the canvas.}
  1876.           if (PageNumber >= 1) and (PageNumber <= PageCount) then
  1877.           begin
  1878.                {Shrink the Rect for the picture to go in}
  1879.                Inc(R.Left, ScaleValue(GutterLeft, True)+1);
  1880.                Inc(R.Top, ScaleValue(GutterTop, False)+1);
  1881.                Inc(R.Right, 1);
  1882.                Inc(R.Bottom, 1);
  1883.                {Get the picture and draw it.}
  1884.                StretchDraw(R, Pages[PageNumber]);
  1885.           end;
  1886.  
  1887.           {Draw the margins if necessary.}
  1888.           if ShowMargins then
  1889.           begin
  1890.                Pen.Style:=psDot;
  1891.                Pen.Color:=clSilver;
  1892.                Brush.Style:=bsClear;
  1893.  
  1894.                Inc(MarginRect.Left, ScaleValue(MarginLeft, True));
  1895.                Inc(MarginRect.Top, ScaleValue(MarginTop, False));
  1896.                Dec(MarginRect.Right, ScaleValue(MarginRight, True));
  1897.                Dec(MarginRect.Bottom, ScaleValue(MarginBottom, False));
  1898.                Rectangle( MarginRect.Left, MarginRect.Top,
  1899.                           MarginRect.Right, MarginRect.Bottom );
  1900.           end;
  1901.           {Leave the pen so the TPaintBox}
  1902.           {design time border doesn't show.}
  1903.           Pen.Color:=Color;
  1904.      end;
  1905. end;
  1906.  
  1907. function TPagePrinter.GetPageCount: Cardinal;
  1908. begin
  1909.      if (fPages <> nil) then
  1910.         Result := fPages.Count
  1911.      else
  1912.          Result := 0;
  1913. end;
  1914.  
  1915. function TPagePrinter.GetZoomPercent: Cardinal;
  1916. begin
  1917.      {C++Builder 1.0 doesn't like Cardinal properties
  1918.      (or String properties) with a SetXXX procedure and
  1919.      no GetXXX function.  It will always read 0 in that
  1920.      situation.  However, Cardinal properties with no
  1921.      Get and no Set as well as properties with both
  1922.      Get and Set functions work. Thus the existence
  1923.      of this little function.} 
  1924.      Result:=fZoomPercent;
  1925. end;
  1926.  
  1927. procedure TPagePrinter.SetZoomPercent(Value: Cardinal);
  1928. begin
  1929.      fZoomPercent:=Value;
  1930.      UpdatePagePreviewSize;
  1931.      Invalidate;
  1932. end;
  1933.  
  1934. procedure TPagePrinter.ResetPageList(CreateForReal: Boolean);
  1935. begin
  1936.      FinishPrintPage;
  1937.      {Destroy the old list and all pages it contains.}
  1938.      fPages.Free;
  1939.      fPage := nil;
  1940.      {Create a new, empty list.}
  1941.      fPages:=TPageList.Create;
  1942.      fPageNumber:=0;
  1943.      {Create a new page so all the Canvas functions work.}
  1944.      if CreateForReal then
  1945.         NewPrintPage
  1946.      else
  1947.          CreateTempPage;
  1948. end;
  1949.  
  1950. procedure TPagePrinter.NewPrintPage;
  1951. begin
  1952.      CreateTempPage;
  1953.      fUsingTempPage:=False;
  1954.      fPages.Add(fPage);
  1955. end;
  1956.  
  1957. procedure TPagePrinter.FinishPrintPage;
  1958. begin
  1959.      fCanvas.Free;
  1960.      fCanvas:=nil;
  1961.      if fUsingTempPage then fPage.Free;
  1962. end;
  1963.  
  1964. procedure TPagePrinter.CreateTempPage;
  1965. begin
  1966.      FinishPrintPage;
  1967.      fUsingTempPage:=True;
  1968.      fPage:=TPrintPage.Create;
  1969.      {We MUST set the page height and width before we create the canvas.}
  1970.      fPage.Width:=MeasureUnitsToPixelsH(PhysicalPageWidth-GutterRight);
  1971.      fPage.Height:=MeasureUnitsToPixelsV(PhysicalPageHeight-GutterBottom);
  1972.  
  1973.      fCanvas:=TPrintCanvas.Create(fPage, GetPrinterHandle);
  1974.      fCanvas.Brush.Style:=bsClear;
  1975.      fCanvas.Font.Assign(Font);
  1976.      SetPixelsPerInch;
  1977. end;
  1978.  
  1979. procedure TPagePrinter.ZoomToFit;
  1980. var
  1981.    PagePixelsWidth, PagePixelsHeight: TPixels;
  1982. begin
  1983.      PagePixelsHeight:=GetPreviewPagePixelsV;
  1984.      PagePixelsWidth:=GetPreviewPagePixelsH;
  1985.      if (PagePixelsWidth/PagePixelsHeight) > (ClientWidth/ClientHeight) then
  1986.         ZoomToWidth
  1987.      else
  1988.          ZoomToHeight;
  1989. end;
  1990.  
  1991. procedure TPagePrinter.ZoomToWidth;
  1992. var
  1993.    ScrollWidth: Integer;
  1994. begin
  1995.      ScrollWidth:=GetSystemMetrics(SM_CXVSCROLL);
  1996.      ZoomPercent:=Trunc(((100*(ClientWidth-ScrollWidth-2*(ShadowOffset+1)))*GetScaleFactor(True))/MeasureUnitsToPixelsH(PhysicalPageWidth));
  1997. end;
  1998.  
  1999. procedure TPagePrinter.ZoomToHeight;
  2000. var
  2001.    ScrollHeight: Integer;
  2002. begin
  2003.      ScrollHeight:=GetSystemMetrics(SM_CYHSCROLL);
  2004.      ZoomPercent:=Trunc(((100*(ClientHeight-ScrollHeight-2*(ShadowOffset+1)))*GetScaleFactor(False))/MeasureUnitsToPixelsV(PhysicalPageHeight));
  2005. end;
  2006.  
  2007. function TPagePrinter.GetScaleFactor(Horz: Boolean): Double;
  2008. var
  2009.    Index: Integer;
  2010. begin
  2011.      Result:=1;
  2012.      if not fStillCreating then
  2013.      begin
  2014.           if Horz then Index:=LOGPIXELSX
  2015.           else Index:=LOGPIXELSY;
  2016.  
  2017.           try
  2018.              Result:=GetDeviceCaps(fPrinter.Handle, Index) / GetDeviceCaps(fPaintBox.Canvas.Handle, Index);
  2019.           except
  2020.                 on EPrinter do Result:=1;
  2021.           end;
  2022.      end;
  2023. end;
  2024.  
  2025. function TPagePrinter.GetPreviewPagePixels(Horz: Boolean): TPixels;
  2026. var
  2027.    Index: Integer;
  2028.    Measure: TMeasurement;
  2029. begin
  2030.      if Horz then Index:=PHYSICALWIDTH
  2031.      else Index:=PHYSICALHEIGHT;
  2032.  
  2033.      try
  2034.         Result:=GetDeviceCaps(fPrinter.Handle, Index);
  2035.      except
  2036.            on EPrinter do
  2037.            begin
  2038.                 if MeasureUnit = muInches then
  2039.                 begin
  2040.                      if Horz then Measure:=DefaultPhysicalPageWidthIn
  2041.                      else Measure:=DefaultPhysicalPageHeightIn;
  2042.                 end
  2043.                 else
  2044.                 begin
  2045.                      if Horz then Measure:=DefaultPhysicalPageWidthMm
  2046.                      else Measure:=DefaultPhysicalPageHeightMm;
  2047.                 end;
  2048.                 Result:=MeasureUnitsToScreenPixels(Measure, Horz);
  2049.            end;
  2050.      end;
  2051.      Result:=Round((Result*ZoomPercent/GetScaleFactor(Horz))/100);
  2052. end;
  2053.  
  2054. function TPagePrinter.GetPreviewPagePixelsH: TPixels;
  2055. begin
  2056.      Result:=GetPreviewPagePixels(True);
  2057. end;
  2058.  
  2059. function TPagePrinter.GetPreviewPagePixelsV: TPixels;
  2060. begin
  2061.      Result:=GetPreviewPagePixels(False);
  2062. end;
  2063.  
  2064. procedure TPagePrinter.SetPageNumber(Value: Cardinal);
  2065. begin
  2066.      if (Value >= 1) and (Value <= PageCount) then
  2067.      begin
  2068.           fPageNumber:=Value;
  2069.           UpdatePagePreviewSize;
  2070.           Invalidate;
  2071.      end
  2072.      else
  2073.      begin
  2074.           if (csLoading in ComponentState) or (PageCount = 0) then
  2075.              fPageNumber:=0
  2076.           else
  2077.               raise EPagePrinter.Create('PageNumber must be between 1 and '+IntToStr(PageCount));
  2078.      end;
  2079. end;
  2080.  
  2081. procedure TPagePrinter.SetShadowOffset(Value: TPixels);
  2082. begin
  2083.      if Value <> fShadowOffset then
  2084.      begin
  2085.           fShadowOffset:=Value;
  2086.           UpdatePagePreviewSize;
  2087.           Invalidate;
  2088.      end;
  2089. end;
  2090.  
  2091. procedure TPagePrinter.UpdatePagePreviewSize;
  2092. begin
  2093.      {Setup the scrolling region.}
  2094.      HorzScrollBar.Range := GetPreviewPagePixelsH+2*(ShadowOffset+1);
  2095.      VertScrollBar.Range := GetPreviewPagePixelsV+2*(ShadowOffset+1);
  2096.      if not fStillCreating then
  2097.      begin
  2098.           case ZoomLocation of
  2099.                zlTopLeft:
  2100.                begin
  2101.                     {Sometimes nothing happens if I go straight to 0;}
  2102.                     HorzScrollBar.Position := 1;
  2103.                     HorzScrollBar.Position := 0;
  2104.                     VertScrollBar.Position := 1;
  2105.                     VertScrollBar.Position := 0;
  2106.                end;
  2107.                zlTopCenter: //Center the page horizontally and go to top vertically.
  2108.                begin
  2109.                     HorzScrollBar.Position := (HorzScrollBar.Range - ClientWidth) div 2;
  2110.                     VertScrollBar.Position := 1;
  2111.                     VertScrollBar.Position := 0;
  2112.                end;
  2113.                zlCenter:
  2114.                begin
  2115.                     HorzScrollBar.Position := (HorzScrollBar.Range - ClientWidth) div 2;
  2116.                     VertScrollBar.Position := (VertScrollBar.Range - ClientHeight) div 2;
  2117.                end;
  2118.           end;
  2119.      end;
  2120. end;
  2121.  
  2122. procedure TPagePrinter.Loaded;
  2123. begin
  2124.      inherited Loaded;
  2125.      RefreshProperties;
  2126.      ResetPageList(False);
  2127.      UpdatePagePreviewSize;
  2128.      {Make it so the TPaintBox design time border is invisible.}
  2129.      fPaintBox.Canvas.Pen.Color:=Color;
  2130.      Invalidate;
  2131. end;
  2132.  
  2133. procedure TPagePrinter.CMFontChanged(var Msg: TMessage);
  2134. begin
  2135.      inherited;
  2136.      Canvas.Font.Assign(Font);
  2137.      SetPixelsPerInch;
  2138.      GetTextMetrics(GetPrinterHandle, fTextMetrics);
  2139.      {Force fLineSpace to be updated.}
  2140.      SetLineSpacing(LineSpacing);
  2141.      if AutoHeaderFont then HeaderFont:=Font;
  2142.      if AutoFooterFont then FooterFont:=Font;
  2143. end;
  2144.  
  2145. procedure TPagePrinter.SetShadowColor(Value: TColor);
  2146. begin
  2147.      if Value <> fShadowColor then
  2148.      begin
  2149.           fShadowColor:=Value;
  2150.           Invalidate;
  2151.      end;
  2152. end;
  2153.  
  2154. procedure TPagePrinter.SetShowMargins(Value: Boolean);
  2155. begin
  2156.      if Value <> fShowMargins then
  2157.      begin
  2158.           fShowMargins:=Value;
  2159.           Invalidate;
  2160.      end;
  2161. end;
  2162.  
  2163. procedure TPagePrinter.SetGradientBackground(Value: Boolean);
  2164. begin
  2165.      if Value <> fGradientBackground then
  2166.      begin
  2167.           fGradientBackground:=Value;
  2168.           Invalidate;
  2169.      end;
  2170. end;
  2171.  
  2172. procedure TPagePrinter.UpdateDesigner;
  2173. begin
  2174.      if csDesigning in ComponentState then
  2175.         if (GetParentForm(Self) <> nil) then
  2176.            if (GetParentForm(Self).Designer <> nil) then
  2177.               GetParentForm(Self).Designer.Modified;
  2178. end;
  2179.  
  2180. procedure TPagePrinter.ExpandFriendlyFormat(const UserFmt: String; AsHeader: Boolean);
  2181. var
  2182.    LayoutTokens: TStringList;
  2183.    NextCharIsSpecifier, TextAddOn: Boolean;
  2184.    i: Integer;
  2185.    FmtText, FmtLayout, Value: String;
  2186. begin
  2187.     LayoutTokens:=TStringList.Create;
  2188.     try
  2189.        NextCharIsSpecifier := False;
  2190.        FmtText:='';
  2191.        for i:=1 to Length(UserFmt) do
  2192.        begin
  2193.             {If it's an &, the next char is important.}
  2194.             if (UserFmt[i] = '&') then
  2195.                NextCharIsSpecifier := True
  2196.             {The current char is a specifier of some sort.}
  2197.             else if NextCharIsSpecifier then
  2198.             begin
  2199.                  Value := '';
  2200.                  TextAddOn := True;
  2201.                  case UserFmt[i] of
  2202.                      'f': Value := ExtractFileName(FileName);
  2203.                      'F': Value := FileName;
  2204.                      'd': Value := FormatDateTime('ddddd', Date);
  2205.                      't': Value := FormatDateTime('t', Time);
  2206.                      'D': Value := FormatDateTime('dddddd', Date);
  2207.                      'T': Value := FormatDateTime('tt', Time);
  2208.                      'p': Value := PageField;
  2209.                      'i': Value := TitleField;
  2210.                      '&': Value := '&';
  2211.                      'l': begin Value := '<'; TextAddOn := False; end;
  2212.                      'c': begin Value := '^'; TextAddOn := False; end;
  2213.                      'r': begin Value := '>'; TextAddOn := False; end;
  2214.                  end;
  2215.                  {An empty filename will throw things off so we put in a space.}
  2216.                  if Value = '' then Value:=' ';
  2217.  
  2218.                  if TextAddOn then
  2219.                     FmtText:=FmtText+Value
  2220.                  else //We encountered an alignment specifier.
  2221.                  begin
  2222.                       if FmtText <> '' then
  2223.                       begin
  2224.                            if LayoutTokens.Count = 0 then LayoutTokens.Add('<');
  2225.                            FmtText:=FmtText+TokenSeparator;
  2226.                       end;
  2227.                       LayoutTokens.Add(Value);
  2228.                  end;
  2229.                  NextCharIsSpecifier := False;
  2230.             end
  2231.             {Otherwise we just add it on the Text string.}
  2232.             else
  2233.                 FmtText:=FmtText+UserFmt[i];
  2234.        end;
  2235.  
  2236.        {Now build the Layout string;}
  2237.        FmtLayout:='';
  2238.        if LayoutTokens.Count = 0 then LayoutTokens.Add('<');
  2239.        Value := Trim(FloatToStrF((PrintableWidth / LayoutTokens.Count), ffFixed, 8, 2));
  2240.        for i:=0 to LayoutTokens.Count-1 do
  2241.        begin
  2242.             if FmtLayout <> '' then FmtLayout:=FmtLayout+TokenSeparator;
  2243.             FmtLayout:=FmtLayout+LayoutTokens[i]+Value;
  2244.        end;
  2245.     finally
  2246.            LayoutTokens.Free;
  2247.     end;
  2248.  
  2249.     {Now set the header or footer properties.}
  2250.     if AsHeader then
  2251.     begin
  2252.          Header:=FmtText;
  2253.          HeaderFormat:=FmtLayout;
  2254.     end
  2255.     else
  2256.     begin
  2257.          Footer:=FmtText;
  2258.          FooterFormat:=FmtLayout;
  2259.     end;
  2260. end;
  2261.  
  2262. function TPagePrinter.GetFriendlyFooter: String;
  2263. begin
  2264.      Result:=fFriendlyFooter;
  2265. end;
  2266.  
  2267. procedure TPagePrinter.SetFriendlyFooter(Value: String);
  2268. begin
  2269.      fFriendlyFooter:=Value;
  2270.      if not (csLoading in ComponentState) then
  2271.         ExpandFriendlyFormat(Value, False);
  2272. end;
  2273.  
  2274. function TPagePrinter.GetFriendlyHeader: String;
  2275. begin
  2276.      Result:=fFriendlyHeader;
  2277. end;
  2278.  
  2279. procedure TPagePrinter.SetFriendlyHeader(Value: String);
  2280. begin
  2281.      fFriendlyHeader:=Value;
  2282.      if not (csLoading in ComponentState) then
  2283.         ExpandFriendlyFormat(Value, True);
  2284. end;
  2285.  
  2286. function TPagePrinter.GetPrinterHandle: HDC;
  2287. begin
  2288.      try
  2289.         Result:=fPrinter.Handle;
  2290.      except
  2291.            on EPrinter do Result:=0;
  2292.      end;
  2293. end;
  2294.  
  2295. procedure TPagePrinter.SetCopies(Value: Cardinal);
  2296. begin
  2297.      if Value > 0 then
  2298.         fCopies:=Value
  2299.      else
  2300.          fCopies:=1;
  2301. end;
  2302.  
  2303. function TPagePrinter.GetCopies: Cardinal;
  2304. begin
  2305.      GetCopies:=fCopies;
  2306. end;
  2307.  
  2308. procedure TPagePrinter.SetCollate(Value: Boolean);
  2309. begin
  2310.      fCollate:=Value
  2311. end;
  2312.  
  2313. function TPagePrinter.GetPrintToPage: Cardinal;
  2314. begin
  2315.      Result:=fPrintToPage;
  2316. end;
  2317.  
  2318. procedure TPagePrinter.SetPrintToPage(Value: Cardinal);
  2319. begin
  2320.      if Value <> fPrintToPage then
  2321.      begin
  2322.           fPrintToPage:=Value;
  2323.           if fPrintToPage < fPrintFromPage then
  2324.              PrintFromPage:=fPrintToPage;
  2325.      end;
  2326. end;
  2327.  
  2328. function TPagePrinter.GetPrintFromPage: Cardinal;
  2329. begin
  2330.      Result:=fPrintFromPage;
  2331. end;
  2332.  
  2333. procedure TPagePrinter.SetPrintFromPage(Value: Cardinal);
  2334. begin
  2335.      if Value <> fPrintFromPage then
  2336.      begin
  2337.           fPrintFromPage:=Value;
  2338.           if fPrintFromPage > fPrintToPage then
  2339.              PrintToPage:=fPrintFromPage;
  2340.      end;
  2341. end;
  2342.  
  2343. type //This type is only used in this function.
  2344.   ECancelPrinting = class(EPagePrinter);
  2345.  
  2346. function TPagePrinter.Print: Boolean;
  2347.     procedure DoPrintPage(Pg, FromPage, ToPage: Integer; LastPage: Boolean);
  2348.     begin
  2349.          {Cancel printing if necessary.}
  2350.          if ShowProgress and ShowCancel then
  2351.             Application.ProcessMessages;
  2352.          if fCancelPrinting then
  2353.             raise ECancelPrinting.Create('Printing Cancelled');
  2354.             
  2355.          {Now print the page.}
  2356.          UpdateProgressDlg(ProgressMessage, Pg, FromPage, ToPage);
  2357.          fPrinter.Canvas.Draw(0, 0, Pages[Pg]);
  2358.          if not LastPage then fPrinter.NewPage;
  2359.     end;    
  2360. var
  2361.    Cp, Pg, PrevPrnCopies: Integer;
  2362.    ToPage, FromPage: Cardinal;
  2363. begin
  2364.      {Return True unless printing was cancelled.}
  2365.      Result:=True;
  2366.      {Call EndDoc if necessary.}
  2367.      if Printing then EndDoc;
  2368.  
  2369.      if PageCount > 0 then
  2370.      begin
  2371.           {Determine the page range to print.}
  2372.           if PrintFromPage = 0 then
  2373.              FromPage:=1
  2374.           else
  2375.               FromPage:=Minimum(PrintFromPage, PageCount);
  2376.           if PrintToPage = 0 then
  2377.              ToPage:=PageCount
  2378.           else
  2379.               ToPage:=Minimum(PrintToPage, PageCount);
  2380.  
  2381.           {We're handling the copies not the printer.}
  2382.           PrevPrnCopies:=fPrinter.Copies;
  2383.           fPrinter.Copies:=1;
  2384.           
  2385.           {Set up the print cancelling code.}
  2386.           fCancelPrinting:=False;
  2387.           try
  2388.              {Print the pages on the printer using Collate and Copies.}
  2389.              try
  2390.                 fPrinter.BeginDoc;
  2391.                 if Collate then //Print 1,2,3; 1,2,3
  2392.                 begin
  2393.                      for Cp:=1 to Copies do
  2394.                          for Pg:=FromPage to ToPage do
  2395.                              DoPrintPage(Pg, FromPage, ToPage, ((Pg=ToPage) and (Cp=Copies)));
  2396.                 end
  2397.                 else //Print 1,1; 2,2; 3,3
  2398.                 begin
  2399.                      for Pg:=FromPage to ToPage do
  2400.                          for Cp:=1 to Copies do
  2401.                              DoPrintPage(Pg, FromPage, ToPage, ((Pg=ToPage) and (Cp=Copies)));
  2402.                 end;
  2403.                 fPrinter.EndDoc;
  2404.              finally
  2405.                     UpdateProgressDlg(ProgressFinishMsg, 0, 0, 0);
  2406.                     if not fPrinter.Printing then
  2407.                        fPrinter.Copies:=PrevPrnCopies;
  2408.              end;
  2409.           except
  2410.                 on ECancelPrinting do
  2411.                 begin
  2412.                      Result:=False; //Return False since is was cancelled.
  2413.                      if fPrinter.Printing then
  2414.                      begin
  2415.                           {I'd like to always Abort printing,
  2416.                           but I've found that calling Abort
  2417.                           multiple times will crash programs.
  2418.                           Thus you can optionally use EndDoc.}
  2419.                           if AbortOnCancel then fPrinter.Abort
  2420.                           else fPrinter.EndDoc;
  2421.                      end;
  2422.                 end;
  2423.           end;
  2424.      end;
  2425. end;
  2426.  
  2427. function TPagePrinter.GetHeaderFont: TFont;
  2428. begin
  2429.      Result:=fHeaderFont;
  2430. end;
  2431.  
  2432. procedure TPagePrinter.SetHeaderFont(Value: TFont);
  2433. begin
  2434.      fHeaderFont.Assign(Value);
  2435. end;
  2436.  
  2437. function TPagePrinter.GetFooterFont: TFont;
  2438. begin
  2439.      Result:=fFooterFont;
  2440. end;
  2441.  
  2442. procedure TPagePrinter.SetFooterFont(Value: TFont);
  2443. begin
  2444.      fFooterFont.Assign(Value);
  2445. end;
  2446.  
  2447. procedure TPagePrinter.SetAutoHeaderFont(Value: Boolean);
  2448. begin
  2449.      if fAutoHeaderFont <> Value then
  2450.      begin
  2451.           fAutoHeaderFont:=Value;
  2452.           if not (csLoading in ComponentState) then
  2453.              if fAutoHeaderFont then
  2454.                 HeaderFont:=Font;
  2455.      end;
  2456. end;
  2457.  
  2458. procedure TPagePrinter.SetAutoFooterFont(Value: Boolean);
  2459. begin
  2460.      if fAutoFooterFont <> Value then
  2461.      begin
  2462.           fAutoFooterFont:=Value;
  2463.           if not (csLoading in ComponentState) then
  2464.              if fAutoFooterFont then
  2465.                 FooterFont:=Font;
  2466.      end;
  2467. end;
  2468.  
  2469. procedure TPagePrinter.Invalidate;
  2470. begin
  2471.      if fUpdateRefCount = 0 then
  2472.         inherited Invalidate;
  2473. end;
  2474.  
  2475. procedure TPagePrinter.BeginUpdate;
  2476. begin
  2477.      Inc(fUpdateRefCount);
  2478. end;
  2479.  
  2480. procedure TPagePrinter.EndUpdate;
  2481. begin
  2482.      if fUpdateRefCount > 0 then Dec(fUpdateRefCount);
  2483.      if fUpdateRefCount = 0 then Invalidate;
  2484. end;
  2485.  
  2486. function TPagePrinter.GetCanvasPosition: TPoint;
  2487. begin
  2488.      Result:=Point(fCurrentX+StartingLeft, fCurrentY+StartingTop);
  2489. end;
  2490.  
  2491. function TPagePrinter.GetPages(Indx: Cardinal): TPrintPage;
  2492. begin
  2493.      Result:=fPages.GetPage(Indx-1);
  2494. end;
  2495.  
  2496. function TPagePrinter.GetProgressMessage: String;
  2497. begin
  2498.      Result:=fProgressMessage;
  2499. end;
  2500.  
  2501. procedure TPagePrinter.SetProgressMessage(Value: String);
  2502. begin
  2503.      fProgressMessage:=Value;
  2504. end;
  2505.  
  2506. function TPagePrinter.GetCanvas: TPrintCanvas;
  2507. begin
  2508.      Result:=fCanvas;
  2509. end;
  2510.  
  2511. function TPagePrinter.GetLineNumber: Cardinal;
  2512. begin
  2513.      Result:=fLineNumber;
  2514. end;
  2515.  
  2516. function TPagePrinter.GetAutoFooterFont: Boolean;
  2517. begin
  2518.      Result:=fAutoFooterFont;
  2519. end;
  2520.  
  2521. function TPagePrinter.GetAutoHeaderFont: Boolean;
  2522. begin
  2523.      Result:=fAutoHeaderFont;
  2524. end;
  2525.  
  2526. function TPagePrinter.GetCollate: Boolean;
  2527. begin
  2528.      Result:=fCollate;
  2529. end;
  2530.  
  2531. function TPagePrinter.GetDefaultColWidth: TMeasurement;
  2532. begin
  2533.      Result:=fDefaultColWidth;
  2534. end;
  2535.  
  2536. function TPagePrinter.GetGradientBackground: Boolean;
  2537. begin
  2538.      Result:=fGradientBackground;
  2539. end;
  2540.  
  2541. function TPagePrinter.GetLineSpacing: TLineSpacing;
  2542. begin
  2543.      Result:=fLineSpacing;
  2544. end;
  2545.  
  2546. function TPagePrinter.GetMarginBottom: TMeasurement;
  2547. begin
  2548.      Result:=fMarginBottom;
  2549. end;
  2550.  
  2551. function TPagePrinter.GetMarginLeft: TMeasurement;
  2552. begin
  2553.      Result:=fMarginLeft;
  2554. end;
  2555.  
  2556. function TPagePrinter.GetMarginRight: TMeasurement;
  2557. begin
  2558.      Result:=fMarginRight;
  2559. end;
  2560.  
  2561. function TPagePrinter.GetMarginTop: TMeasurement;
  2562. begin
  2563.      Result:=fMarginTop;
  2564. end;
  2565.  
  2566. function TPagePrinter.GetMeasureUnit: TMeasureUnit;
  2567. begin
  2568.      Result:=fMeasureUnit;
  2569. end;
  2570.  
  2571. function TPagePrinter.GetPageBorderOffset: TMeasurement;
  2572. begin
  2573.      Result:=fPageBorderOffset;
  2574. end;
  2575.  
  2576. function TPagePrinter.GetPrintToFile: Boolean;
  2577. begin
  2578.      Result:=fPrintToFile;
  2579. end;
  2580.  
  2581. function TPagePrinter.GetShadowColor: TColor;
  2582. begin
  2583.      Result:=fShadowColor;
  2584. end;
  2585.  
  2586. function TPagePrinter.GetShadowOffset: TPixels;
  2587. begin
  2588.      Result:=fShadowOffset;
  2589. end;
  2590.  
  2591. function TPagePrinter.GetShowMargins: Boolean;
  2592. begin
  2593.      Result:=fShowMargins;
  2594. end;
  2595.  
  2596. function TPagePrinter.GetShowProgress: Boolean;
  2597. begin
  2598.      Result:=fShowProgress;
  2599. end;
  2600.  
  2601. function TPagePrinter.GetPageBorders: TPageBorders;
  2602. begin
  2603.      Result:=fPageBorders;
  2604. end;
  2605.  
  2606. procedure TPagePrinter.SetPageBorders(Value: TPageBorders);
  2607. begin
  2608.      fPageBorders:=Value;
  2609. end;
  2610.  
  2611. procedure TPagePrinter.OnCancelPrinting(Sender: TObject);
  2612. begin
  2613.      fCancelPrinting:=True;
  2614. end;
  2615.  
  2616. procedure TPagePrinter.SetShowProgress(Value: Boolean);
  2617. begin
  2618.      fShowProgress:=Value;
  2619. end;
  2620.  
  2621. function TPagePrinter.GetShowCancel: Boolean;
  2622. begin
  2623.      Result:=fShowCancel;
  2624. end;
  2625.  
  2626. procedure TPagePrinter.SetShowCancel(Value: Boolean);
  2627. begin
  2628.      fShowCancel:=Value;
  2629. end;
  2630.  
  2631. function TPagePrinter.StoreFooterAndFormat: Boolean;
  2632. begin
  2633.      Result:=FriendlyFooter = '';
  2634. end;
  2635.  
  2636. function TPagePrinter.StoreFooterFont: Boolean;
  2637. begin
  2638.      Result:=not AutoFooterFont;
  2639. end;
  2640.  
  2641. function TPagePrinter.StoreHeaderAndFormat: Boolean;
  2642. begin
  2643.      Result:=FriendlyHeader = '';
  2644. end;
  2645.  
  2646. function TPagePrinter.StoreHeaderFont: Boolean;
  2647. begin
  2648.      Result:=not AutoHeaderFont;
  2649. end;
  2650.  
  2651. function TPagePrinter.ValidateFormatString(const Fmt: String; const ConvertUnits: Boolean): String;
  2652. var
  2653.    FormatTokens: TStringList;
  2654.    i: Integer;
  2655.    CurAlignment: TAlignment;
  2656.    CurWidth: TMeasurement;
  2657.    AlignmentChar: Char;
  2658.    Buffer: String;
  2659. begin
  2660.      Result:='';
  2661.      if Fmt <> '' then
  2662.      begin
  2663.           FormatTokens:=TStringList.Create;
  2664.           try
  2665.              TokenizeString(Fmt, TokenSeparator, FormatTokens);
  2666.              for i:=0 to FormatTokens.Count-1 do
  2667.              begin
  2668.                   Buffer:=FormatTokens[i];
  2669.                   ParseFormatToken(Buffer, CurAlignment, CurWidth);
  2670.                   if Result <> '' then Result:=Result+TokenSeparator;
  2671.                   case CurAlignment of
  2672.                        taRightJustify: AlignmentChar:='>';
  2673.                        taCenter: AlignmentChar:='^';
  2674.                   else
  2675.                       AlignmentChar:='<';
  2676.                   end;
  2677.                   if ConvertUnits then
  2678.                   begin
  2679.                        if MeasureUnit = muInches then CurWidth:=CurWidth/25.4
  2680.                        else CurWidth:=CurWidth*25.4;
  2681.                   end;
  2682.                   Result:=Result+AlignmentChar+Trim(FloatToStr(CurWidth));
  2683.              end;
  2684.           finally
  2685.                  FormatTokens.Free;
  2686.           end;
  2687.      end;
  2688. end;
  2689.  
  2690. function TPagePrinter.GetFooterFormat: String;
  2691. begin
  2692.      Result:=fFooterFormat;
  2693. end;
  2694.  
  2695. procedure TPagePrinter.SetFooterFormat(Value: String);
  2696. begin
  2697.      fFooterFormat:=ValidateFormatString(Value, false);
  2698. end;
  2699.  
  2700. function TPagePrinter.GetHeaderFormat: String;
  2701. begin
  2702.      Result:=fHeaderFormat;
  2703. end;
  2704.  
  2705. procedure TPagePrinter.SetHeaderFormat(Value: String);
  2706. begin
  2707.      fHeaderFormat:=ValidateFormatString(Value, false);
  2708. end;
  2709.  
  2710. function TPagePrinter.GetTableFormat: String;
  2711. begin
  2712.      Result:=fTableFormat;
  2713. end;
  2714.  
  2715. procedure TPagePrinter.SetTableFormat(Value: String);
  2716. begin
  2717.      fTableFormat:=ValidateFormatString(Value, false);
  2718. end;
  2719.  
  2720. end.
  2721.  
  2722.